webserver

#!/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 ;
        }
}