#!/usr/bin/perl # $Id: webserver,v 1.6 2019/11/28 14:45:09 gilles Exp gilles $ package Imapsync; use base qw(Net::Server::HTTP); use strict ; use warnings ; use Data::Dumper ; use English qw( -no_match_vars ) ; my $server = Imapsync->new( 'port' => [8080], 'access_log_file' => 'STDERR', 'log_level' => 4, 'timeout_header' => 20, 'timeout_idle' => 60, ) ; $server->run() ; sub default_server_type { 'Fork' } sub post_configure_hook { my $self = shift ; $self->log( 2, Data::Dumper->Dump( [ $self ], ['self'] ) ) ; } sub output_file { my ( $self, $file, $type ) = @_ ; $type ||= 'text/plain' ; my $string = file_to_string( $file ) ; my $output ; my( $status, $msg, $body ) ; if ( defined $string ) { $output = "Content-type: $type\r\n\r\n" ; $output .= $string ; # body can not be sent by send_status() because then it # sets Content-type to text/html $self->send_status( '200', 'OK' ) ; print $output ; } else { $self->send_status( '404', 'Not found', "File not found: $file " ) ; } return ; } sub process_path_info { my $self = shift ; my $path_info = shift ; my $sitemap = { '/imapsync_form_extra.html' => sub { output_file( $self, './X/imapsync_form_extra.html', 'text/html' ) }, '/imapsync_form.html' => sub { output_file( $self, './X/imapsync_form.html', 'text/html' ) }, '/imapsync_form.css' => sub { output_file( $self, './X/imapsync_form.css', 'text/css' ) }, '/imapsync_form.js' => sub { output_file( $self, './X/imapsync_form.js', 'text/javascript' ) }, '/imapsync_form_new.js' => sub { output_file( $self, './X/imapsync_form_new.js', 'text/javascript' ) }, '/' => sub { output_file( $self, './X/imapsync_form_extra.html', 'text/html' ) }, '/vnstat/vnstati.html' => sub { output_file( $self, './X/vnstati.html', 'text/html' ) }, } ; if ( defined $sitemap->{ $path_info } ) { $sitemap->{ $path_info }->() ; } else { $self->send_status( '404', 'Not found', "Error: $path_info not found!\n" ) ; } return ; } sub process_http_request { my $self = shift ; $self->log( 2, "In process_http_request PID $$\n" ) ; local $Data::Dumper::Sortkeys = 1; #$self->log( 2, Data::Dumper->Dump( [ $self ], ['self'] ) ) ; $ENV{'SERVER_SOFTWARE'} = $PROGRAM_NAME ; if ( '/cgi-bin/imapsync' eq $ENV{'PATH_INFO'} ) { #$self->exec_trusted_perl( './imapsync' ) ; $self->exec_cgi( './imapsync' ) ; #$self->exec_cgi( './imapsync_bin_Linux_i686' ) ; #$self->exec_trusted_perl( '.\imapsync.pl' ); $self->log( 2, "In process_http_request PID $$ after exec_trusted_perl\n" ) ; #return ; #return $self->exec_cgi( 'C:\Strawberry\perl\bin\perl.exe .\imapsync.pl' ); #return $self->exec_cgi( 'imapsyncbat' ); #return $self->exec_trusted_perl( 'imapsyncbat' ); } else { process_path_info( $self, $ENV{'PATH_INFO'} ) ; } #$self->log( 4, Data::Dumper->Dump( [ $self ], ['self'] ) ) ; $self->log( 2, "End of process_http_request PID $$\n" ) ; } sub file_to_string { my $file = shift ; if ( ! $file ) { warn "Error, no file given\n" ; return ; } if ( ! -e $file ) { warn "Error, $file does not exist\n" ; return ; } if ( ! -f $file ) { warn "Error, $file is not a file\n" ; return ; } if ( ! -r $file ) { warn "Error, $file is not readable\n" ; return ; } my @string ; if ( open my $FILE, '<', $file ) { @string = <$FILE> ; close $FILE ; my $string = join q{}, @string ; return $string ; }else{ warn "Error reading file $file : $OS_ERROR\n" ; return ; } }