9
\$\begingroup\$

Intro

Finally had the time to do some wargames again, but I have come to the point where I need to build my own test enviroment to test certain ideas, because I can't test it online. The current challenge is some form of SQL Injection in perl, abusing the quoted(param()) call.

The perl code online:

if ('POST' eq request_method && param('username') && param('password')){
    my $dbh = DBI->connect( "DBI:mysql:natas30","natas30", "<censored>", {'RaiseError' => 1});
    my $query="Select * FROM users where username =".$dbh->quote(param('username')) . " and password =".$dbh->quote(param('password')); 
    my $sth = $dbh->prepare($query);
    $sth->execute();
    my $ver = $sth->fetch();
    if ($ver){
        print "win!<br>";
        print "here is your result:<br>";
        print @$ver;
    }
    else{
        print "fail :(";
    }
    $sth->finish();
    $dbh->disconnect();
}

Perl localhost test enviroment

I have tried to create the important features of the webpage, namely that you can post the username and password, compare it to a database entry and give back the result. I have used the HTTP::Server::Simple::CGI as I think it would be the way of keeping things simple.

My recreated perl webpage

use strict;
use warnings;


{
    package Natas30Clone;

    use DBI;
    use HTTP::Server::Simple::CGI;
    our @ISA = qw(HTTP::Server::Simple::CGI);

    my %dispatch = (
        '/login.pl' => \&resp_index,
    );

    sub handle_request {
        my $self = shift;
        my $cgi  = shift;

        my $path = $cgi->path_info();
        my $handler = $dispatch{$path};

        if (ref($handler) eq "CODE") {
            print "HTTP/1.0 200 OK\r\n";
            $handler->($cgi);

        } else {
            print "HTTP/1.0 404 Not found\r\n";
            print $cgi->header,
                $cgi->start_html('Nothing here'),
                $cgi->h1('Move along sir'),
                $cgi->h2('You can got to localhost:8080/index.pl?username=user&password=pass'),
                $cgi->start_form(
                      -method=>'POST',
                      -action=>'/login.pl',
                      ),
                $cgi->p('Username'),
                $cgi->textfield(
                     -name=>'username',
                     ),
                $cgi->p('Password'),
                $cgi->textfield(
                     -name=>'password',
                     -type=>'password',
                     ),
                $cgi->submit(
                     -name=>'submit',
                     -value=>'login',
                     ),
                $cgi->end_form;
        }
    }

    sub resp_index {
        my $cgi  = shift;
        return if !ref $cgi;

        my $dbh = DBI->connect( "DBI:mysql:natas30","root", "toor", {'RaiseError' => 1});

        my $username = $cgi->param('username');
        my $quoted_username =  $dbh->quote($username);  
        my $password = $cgi->param('password');
        my $quoted_password =  $dbh->quote($password);  
        my $query="Select * FROM users where username =" . $quoted_username . " and password =" . $quoted_password; 

        my $sth = $dbh->prepare($query);
        $sth->execute();
        my $ver = $sth->fetch();
        if ($ver){
            print $cgi->header,
                $cgi->start_html("WIN!"),
                $cgi->h1(@$ver),
                $cgi->h2("You succeeded with query " . $query),
                $cgi->h2("Suplied parameters U:" . $username . " P:" . $password),
                $cgi->h2("Quoted parameters U:" . $quoted_username . " P:" . $quoted_password),
                $cgi->end_html;
        } else {
            print $cgi->header,
                $cgi->start_html("FAIL!"),
                $cgi->h2("You failed with query " . $query),
                $cgi->h2("Suplied parameters U:" . $username . " P:" . $password),
                $cgi->h2("Quoted parameters U:" . $quoted_username . " P:" . $quoted_password),
                $cgi->end_html;
        }

        $sth->finish();
        $dbh->disconnect();
    }
}

my $pid = Natas30Clone->new(8080)->background();
print "Use 'kill $pid' to stop server.\n";

MySQL database schema

The MySQL is just a single database natas30 with a table users that looks like this:

+---------+----------+
|  user   | password |
+---------+----------+
| natas30 | natas30  |
+---------+----------+

Python program to test ideas

Below is a little python program I used to test if everything went well:

import requests
session = requests.Session()

def natas30(url):
    params={"username": "natas30", "password": "natas30"}
    response = session.post(url, data=params)
    print(response.text)

if __name__ == '__main__':
    url = 'http://localhost:8080/login.pl'
    natas30(url)

Which gives me the output I expected:

<!DOCTYPE html
    PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
     "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US" xml:lang="en-US">
     <head>
         <title>WIN!</title>
         <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
     </head>
     <body>
        <h1>natas30 natas30</h1>
        <h2>You succeeded with query Select * FROM users where username ='natas30' and password ='natas30'</h2>
        <h2>Suplied parameters U:natas30 P:natas30</h2>
        <h2>Quoted parameters U:'natas30' P:'natas30'</h2>
    </body>
</html>

Questions

  • Is this the correct way of setting up localhost servers? I am still new with Perl, but this seemed a module I could use.
  • Any general tips and tricks I've missed regarding the perl code?

As always any review is welcome!

\$\endgroup\$
  • \$\begingroup\$ One problem is that you have made a simple web server, but it is not CGI. CGI refers to the standard means by which a web server starts up a new process and passes parameters to it, then reads the results from the new process's standard output. You're not doing that here, you're doing everything in the web server. \$\endgroup\$ – Snowbody Dec 20 '17 at 18:31
  • \$\begingroup\$ @Snowbody Can you maybe elborate on this? Because as I said, this is still new for me... I think I know what you mean though. I should print x instead of cgi->x? \$\endgroup\$ – Ludisposed Dec 21 '17 at 8:34
  • 1
    \$\begingroup\$ I'm not sure I fully understand what you are trying to achieve. The thing you're trying to hack (is that the right word?) uses CGI, so your approach to recreate it for testing makes sense. IMO it doesn't matter if the process speaks through he Common Gateway Interface. The bad part is the CGI.pm module, not the way the server works. However, in modern Perl code not only is CGI.pm discouraged (and excluded from the core, yay), but especially the HTML creating functions you are using are abhorred. See this talk by SawyerX. \$\endgroup\$ – simbabque Dec 21 '17 at 12:27
  • 2
    \$\begingroup\$ A more modern approach would be to use PSGI/Plack instead of CGI.pm. You can deploy Pack-based apps in various ways. Typically it's a persistent server process that essentially is its own web server. There exist very scalable implementations with preforking, like Starman or Starlet. This is the default way modern Perl applications like Dancer2 or Catalyst are deployed, and large companies like booking.com use those. Of course, for your test application that would beat the purpose, but I thought to mention it. \$\endgroup\$ – simbabque Dec 21 '17 at 12:29
  • 1
    \$\begingroup\$ There is a way to combine those technologies, though. I've built App::CGIThis, which will turn a directory of .pl CGI scripts into a Plack based web server. Since you seem to have the script the server you are trying to break runs, you could use that directly with cgi_this on your local machine and don't have to worry about any implementation of the server at all. \$\endgroup\$ – simbabque Dec 21 '17 at 12:31
3
\$\begingroup\$

Reiterating

As pointed out in the extensive comments and chat:

  • CGI.pm is officially deprecated and should be avoided for new projects.
  • PSGI/Plack is a more modern way to deploy Perl apps. Check out Mojolicious or Catalyst for good frameworks to start with.
  • going to conferences is fun! (Seriously, read the chat.)

I'm not going to try to rewrite anything based on the first two points. There are plenty of tutorials if not books out there for those frameworks.

Good

I like:

  • use strict is a great habit to stay in. Only one-liners are exempt from this.
  • use warnings is also a great idea. Some folks cut this off for production, but unless your Perl code is tripping over lots of warnings on a regular basis the additional diagnostics when things go wrong can save hours of confusion.
  • your indentation is consistent.
  • using shift to read function parameters.

Overall it was easy to follow the code and see what was happening. I would expect this code to be relatively easy to maintain.

Suggestions

My main gripe with your code is including the bulk of the code indented with squiggly brackets. I understand that this was necessary to have the package apply to the right code, but it would seem much cleaner and less irritating to put the package code into its own file which gets used or required. This will let give you less whitespace on the left and let some of your lines grow longer without growing off of the screen.

Some things that would be nice to have would be:

  • using classic DBI.pm for something this simple is pretty reasonable. For anything more interesting going with something like DBIx::Class will be much less tedious.
  • move the HTML into template files. This would be a natural side-effect of using any of the frameworks mentioned above.
  • a link to your code in a github repo.
  • include the SQL create table and insert to make it easier for others to replicate. Of course these could just be in the suggested github repo if you don't want to cut and paste all of that into your question here. Since we're not reviewing your SQL I think that sticks within the rules here.
  • include the #! line at the top. #!/usr/bin/env perl or #!/usr/bin/perl are common choices.
  • some comments in the code
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.