#!/usr/bin/perl use HTTP::Daemon; use HTTP::Status; use HTTP::Response; use File::Spec; use Getopt::Std; use strict; use warnings; # Filename to use for directory indices. use constant INDEX_FILE => "index.html"; use constant SECS_PER_HOUR => 60*60; use constant SECS_PER_DAY => 60*60*24; my %opts = (); getopts( "p:d:", \%opts ) or die "Invalid argument\n"; my $port = $opts{p} || 8080; my $docroot = $opts{d} || "."; my %DynaPage = ( "/stats" => \&server_stats, "/hello" => \&dynamic_hello, ); my %Stats = ( start => time(), requests => 0, static => 0, notfound => 0, forbidden => 0, ); my $daemon = HTTP::Daemon->new( LocalPort => $port ) or die; print "Please contact me at: url(), ">\n", "Documents in '$docroot'\n"; while (my $conn = $daemon->accept()) { eval { while (my $r = $conn->get_request()) { $Stats{requests}++; my $path = $r->url->path(); if(exists $DynaPage{$path}) { $DynaPage{$path}->( $conn, $r, $path ); } else { handle_static_page( $conn, $r, $path ); } } }; print STDERR "Caught exception: $@" if $@; $conn->close(); undef($conn); } sub resolve_path { my $path = shift; # Fail if illegal characters return undef if $path =~ m![^-a-zA-Z0-9_\./]!; $path = File::Spec->canonpath( File::Spec->catfile( $docroot, $path ) ); # Fail if try to walk out of docroot. return undef if $docroot ne substr( $path, 0, length $docroot ); $path; } # Display a static page off disk. # sub handle_static_page { my $conn = shift; my $r = shift; my $path = resolve_path( shift ); if ($r->method ne "GET" or !defined( $path )) { $conn->send_error( RC_FORBIDDEN ); $Stats{forbidden}++; } elsif(-e $path) { if(-d $path) { $path = File::Spec->catfile( $path, INDEX_FILE ); } if(-r $path) { $conn->send_file_response( $path ); $Stats{static}++; } else { $conn->send_error( RC_FORBIDDEN ); $Stats{forbidden}++; } } else { $conn->send_error( RC_NOT_FOUND ); $Stats{notfound}++; } } # --------------------------- # Dynamic page methods. # sub server_stats { my $conn = shift; my $r = shift; my $upsecs = time - $Stats{start}; my $uptime; if($upsecs > SECS_PER_DAY) { $uptime = sprintf "%d days %2d:%02d", $upsecs/SECS_PER_DAY, ($upsecs % SECS_PER_DAY)/SECS_PER_HOUR, ($upsecs % SECS_PER_HOUR)/60; } else { $uptime = sprintf "%d:%02d:%02d", $upsecs/SECS_PER_HOUR, ($upsecs % SECS_PER_HOUR)/60, $upsecs % 60; } my $resp = new HTTP::Response(); $resp->header( "Content-Type" => "text/plain" ); $resp->content( <<"EOS" ); Server Statistics: UpTime: $uptime Total Requests: $Stats{requests} Static Requests: $Stats{static} Failures: Not Found: $Stats{notfound} Forbidden: $Stats{forbidden} EOS $conn->send_response( $resp ); } sub dynamic_hello { my $conn = shift; my $r = shift; my $name = get_params( $r )->{name} || "request #$Stats{requests}"; my $resp = new HTTP::Response(); $resp->header( "Content-Type" => "text/html" ); $resp->content( <<"EOS" ); Dynamic Hello World

Hello, $name

This is dynamically generated text.

EOS $conn->send_response( $resp ); } sub get_params { my $r = shift; my $qrystr = ""; if($r->method eq "POST") { $qrystr = $r->content; } else { ($qrystr) = $r->url() =~ /\?(.*)/; } return {} unless $qrystr; my @parms = ($qrystr =~ m{ ([^&=]+) # name = # = ([^&=]*) # value &? # separator (not on last) }gx); my %parms = (@parms % 1) ? (@parms, "") : @parms; \%parms; }