package PITA::Guest::Server::HTTP; # The HTTP server component of the support server use 5.008; use strict; use File::Spec (); use POE::Declare::HTTP::Server 0.05 (); our $VERSION = '0.60'; our @ISA = 'POE::Declare::HTTP::Server'; use POE::Declare { Mirrors => 'Param', PingEvent => 'Message', MirrorEvent => 'Message', UploadEvent => 'Message', }; ###################################################################### # Constructor and Accessors sub new { my $self = shift->SUPER::new( Mirrors => { }, @_, Handler => sub { # Convert to a more convention form $_[0]->handler( $_[1]->request, $_[1] ); }, ); # Check and normalize unless ( Params::Util::_HASH0($self->Mirrors) ) { die "Missing or invalid Mirrors param"; } foreach my $route ( sort keys %{$self->Mirrors} ) { my $dir = File::Spec->rel2abs( $self->Mirrors->{$route} ); unless ( -d $dir ) { die "Directory '$dir' for mirror '$route' does not exist"; } $self->Mirrors->{$route} = $dir; } return $self; } ###################################################################### # Main Methods # Sort of half-assed Process compatibility for testing purposes sub run { $_[0]->start; POE::Kernel->run; return 1; } # Wrapper for doing cleansing of the response sub handler { my $self = shift; my $response = $_[1]; # Call the main handler $self->_handler(@_); # Add content length for all responses if ( defined $response->content ) { unless ( $response->header('Content-Length') ) { my $bytes = length $response->content; $response->header( 'Content-Length' => $bytes ); } } return; } sub _handler { my $self = shift; my $request = shift; my $response = shift; my $path = $request->uri->path; if ( $request->method eq 'GET' ) { # Handle a ping if ( $path eq '/' ) { $response->code(200); $response->header( 'Content-Type' => 'text/plain' ); $response->content('200 - PONG'); $self->PingEvent; return; } # Handle a mirror file fetch my $Mirrors = $self->Mirrors; foreach my $route ( sort keys %$Mirrors ) { my $escaped = quotemeta $route; next unless $path =~ /^$escaped(.+)$/; my $file = $1; my $root = $Mirrors->{$route}; my $full = File::Spec->catfile( $root, $file ); if ( -f $full and -r _ ) { # Load the file local $/ = undef; my $io = IO::File->new($full, 'r') or die "open: $full"; $io->binmode; my $blob = $io->getline; # Send the file $response->code(200); $response->header('Content-Type' => 'application/x-gzip'); $response->content($blob); } else { $response->code(404); $response->header('Content-Type' => 'text/plain'); $response->content('404 - File Not Found'); } # Report the mirror event $self->MirrorEvent( $route, $file, $response->code ); return; } } if ( $request->method eq 'PUT' ) { # Send the upload message $self->UploadEvent( $path => \( $request->content ) ); # Send a content-less ok to the client $response->code(204); $response->message('Upload received'); return; } return; } compile;