/ 
mod_perl-1.99_11
River stage three • 156 direct dependents • 184 total dependents
/ docs/TODO

Apache::CommandServer

Our first protocol handler example took advange of Apache's server framework, but did not tap into any other modules. The next example is based on the example in the "TCP Servers with IO::Socket" section of the perlipc manpage. Of course, we don't need IO::Socket since Apache takes care of those details for us. The rest of that example can still be used to illustrate implementing a simple text protocol. In this case, one where a command is sent by the client to be executed on the server side, with results sent back to the client.

The Apache::CommandServer handler will support four commands: motd, date, who and quit. These are probably not commands which can be exploited, but should we add such commands, we'll want to limit access based on ip address/hostname, authentication and authorization. Protocol handlers need to take care of these tasks themselves, since we bypass the HTTP protocol handler.

As with all PerlProcessConnectionHandlers, we are passed an Apache::Connection object as the first argument. Again, we will be directly accessing the client socket via the client_socket method. The login subroutine is called to check if access by this client should be allowed. This routine makes up for what we lost with the core HTTP protocol handler bypassed. First we call the Apache::RequestRec new method, which returns a request_rec object, just like that which is passed at request time to Perl*Handlers and returned by the subrequest API methods, lookup_uri and lookup_file. However, this "fake request" does not run handlers for any of the phases, it simply returns an object which we can use to do that ourselves. The location_merge method is passed the "location" for this request, it will look up the <Location> section that matches the given name and merge it with the default server configuration. For example, should we only wish to allow access to this server from certain locations:

<Location Apache::CommandServer>
    deny from all
    allow from 10.*
</Location>

The location_merge method only looks up and merges the configuration, we still need to apply it. This is done in for loop, iterating over three methods: run_access_checker, run_check_user_id and run_auth_checker. These methods will call directly into the Apache functions that invoke module handlers for these phases and will return an integer status code, such as OK, DECLINED or FORBIDDEN. If run_access_check returns something other than OK or DECLINED, that status will be propagated up to the handler routine and then back up to Apache. Otherwise, the access check passed and the loop will break unless some_auth_required returns true. This would be false given the previous configuration example, but would be true in the presense of a require directive, such as:

<Location Apache::CommandServer>
    deny from all
    allow from 10.*
    require user dougm
</Location>

Given this configuration, some_auth_required will return true. The user method is then called, which will return false if we have not yet authenticated. A prompt utility is called to read the username and password, which are then injected into the headers_in table using the set_basic_credentials method. The Authenticate field in this table is set to a base64 encoded value of the username:password pair, exactly the same format a browser would send for Basic authentication. Next time through the loop run_check_user_id is called, which will in turn invoke any authentication handlers, such as mod_auth. When mod_auth calls the ap_get_basic_auth_pw() API function (as all Basic auth modules do), it will get back the username and password we injected. If we fail authentication a 401 status code is returned which we propagate up. Otherwise, authorization handlers are run via run_auth_checker. Authorization handlers normally need the user field of the request_rec for its checks and that field was filled in when mod_auth called ap_get_basic_auth_pw().

Provided login is a success, a welcome message is printed and main request loop entered. Inside the loop the getline function returns just one line of data, with newline characters stripped. If the string sent by the client is in our command table, the command is then invoked, otherwise a usage message is sent. If the command does not return a true value, we break out of the loop. Let's give it a try with this configuration:

Listen 8085
<VirtualHost _default_:8085>
    PerlProcessConnectionHandler Apache::CommandServer

    <Location Apache::CommandServer>
        allow from 127.0.0.1
        require user dougm
        satisfy any
        AuthUserFile /tmp/basic-auth
    </Location>
</VirtualHost>

% telnet localhost 8085
Trying 127.0.0.1...
Connected to localhost (127.0.0.1).
Escape character is '^]'.
Login: dougm
Password: foo
Welcome to Apache::CommandServer
Available commands: motd date who quit
motd
Have a lot of fun...
date
Mon Mar 12 19:20:10 PST 2001
who
dougm    tty1     Mar 12 00:49
dougm    pts/0    Mar 12 11:23
dougm    pts/1    Mar 12 14:08
dougm    pts/2    Mar 12 17:09
quit
Connection closed by foreign host.

Apache::CommandServer Source

package Apache::CommandServer;

use strict;
use Apache::Connection ();
use APR::Socket ();
use Apache::HookRun ();

use Apache::Const -compile => qw(OK DECLINED);

my @cmds = qw(motd date who quit);
my %commands = map { $_, \&{$_} } @cmds;

sub handler {
    my Apache::Connection $c = shift;
    my APR::Socket $socket = $c->client_socket;

    if ((my $rc = login($c)) != Apache::OK) {
        $socket->send("Access Denied\n");
        return $rc;
    }

    $socket->send("Welcome to " . __PACKAGE__ .
                  "\nAvailable commands: @cmds\n");

    for (;;) {
        my $cmd;
        next unless $cmd = getline($socket);

        if (my $sub = $commands{$cmd}) {
            last unless $sub->($socket) == APR::SUCCESS;
        }
        else {
            $socket->send("Commands: @cmds\n");
        }
    }

    return Apache::OK;
}

sub login {
    my $c = shift;

    my $r = Apache::RequestRec->new($c);
    $r->location_merge(__PACKAGE__);

    for my $method (qw(run_access_checker run_check_user_id run_auth_checker)) {
        my $rc = $r->$method();

        if ($rc != Apache::OK and $rc != Apache::DECLINED) {
            return $rc;
        }

        last unless $r->some_auth_required;

        unless ($r->user) {
            my $socket = $c->client_socket;
            my $username = prompt($socket, "Login");
            my $password = prompt($socket, "Password");

            $r->set_basic_credentials($username, $password);
        }
    }

    return Apache::OK;
}

sub getline {
    my $socket = shift;
    my $line;
    $socket->recv($line, 1024);
    return unless $line;
    $line =~ s/[\r\n]*$//;
    return $line;
}

sub prompt {
    my($socket, $msg) = @_;
    $socket->send("$msg: ");
    getline($socket);
}

sub motd {
    my $socket = shift;
    open my $fh, '/etc/motd' or return;
    local $/;
    my $status = $socket->send(scalar <$fh>);
    close $fh;
    return $status;
}

sub date {
    my $socket = shift;
    $socket->send(scalar(localtime) . "\n");
}

sub who {
    my $socket = shift;
    $socket->send(scalar `who`);
}

sub quit {1}

1;
__END__

---

---

---

---

---

---

---

---

---

---

---

---

---