PERL   17
webserver
Guest on 12th February 2023 10:22:28 AM


  1. #!/usr/bin/perl
  2.  
  3. # $Id: webserver,v 1.6  14:45:09 gilles Exp gilles $
  4. package Imapsync;
  5.  
  6. use base qw(Net::Server::HTTP);
  7. use strict ;
  8. use warnings ;
  9. use Data::Dumper ;
  10. use English qw( -no_match_vars ) ;
  11.  
  12. my $server = Imapsync->new(
  13.         'port'  => [8080],
  14.         'access_log_file' => 'STDERR',
  15.         'log_level' => 4,
  16.         'timeout_header'  => 20,
  17.         'timeout_idle'    => 60,
  18. ) ;
  19.  
  20.  
  21. $server->run() ;
  22.  
  23.  
  24.  
  25.  
  26. sub default_server_type { 'Fork' }
  27.  
  28. sub post_configure_hook
  29. {
  30.         my $self = shift ;
  31.         $self->log( 2, Data::Dumper->Dump( [ $self ], ['self'] ) ) ;
  32. }
  33.  
  34. sub output_file
  35. {
  36.         my ( $self, $file, $type ) = @_ ;
  37.        
  38.         $type ||= 'text/plain' ;
  39.        
  40.         my $string = file_to_string( $file ) ;
  41.        
  42.         my $output ;
  43.         my( $status, $msg, $body ) ;
  44.         if ( defined $string )
  45.         {
  46.                 $output  = "Content-type: $type\r\n\r\n" ;
  47.                 $output .= $string ;
  48.                 # body can not be sent by send_status() because then it
  49.                 # sets Content-type to text/html
  50.                 $self->send_status( '200', 'OK' ) ;
  51.                 print $output ;
  52.                
  53.         }
  54.         else
  55.         {
  56.                 $self->send_status( '404', 'Not found', "File not found: $file " ) ;
  57.         }
  58.        
  59.         return ;
  60. }
  61.  
  62.  
  63. sub process_path_info
  64. {
  65.         my $self      = shift ;
  66.         my $path_info = shift ;
  67.        
  68.         my $sitemap =
  69.         {
  70.                 '/imapsync_form_extra.html' => sub {
  71.                         output_file( $self, './X/imapsync_form_extra.html', 'text/html' )
  72.                 },
  73.                 '/imapsync_form.html'       => sub {
  74.                         output_file( $self, './X/imapsync_form.html', 'text/html' )
  75.                 },
  76.                 '/imapsync_form.css'        => sub {
  77.                         output_file( $self, './X/imapsync_form.css', 'text/css' )
  78.                 },
  79.                 '/imapsync_form.js'         => sub {
  80.                         output_file( $self, './X/imapsync_form.js', 'text/javascript' )
  81.                 },
  82.                 '/imapsync_form_new.js'     => sub {
  83.                         output_file( $self, './X/imapsync_form_new.js', 'text/javascript' )
  84.                 },
  85.                 '/' => sub {
  86.                         output_file( $self, './X/imapsync_form_extra.html', 'text/html' )
  87.                 },
  88.                 '/vnstat/vnstati.html' => sub {
  89.                         output_file( $self, './X/vnstati.html', 'text/html' )
  90.                 },
  91.                
  92.         } ;
  93.        
  94.         if ( defined $sitemap->{ $path_info } )
  95.         {
  96.                 $sitemap->{ $path_info }->() ;
  97.         }
  98.         else
  99.         {
  100.                 $self->send_status( '404', 'Not found', "Error: $path_info not found!\n" ) ;
  101.         }
  102.         return ;
  103.  
  104. }
  105.  
  106. sub process_http_request
  107. {
  108.         my $self = shift ;
  109.        
  110.         $self->log( 2, "In process_http_request PID $$\n" ) ;
  111.         local $Data::Dumper::Sortkeys = 1;
  112.         #$self->log( 2, Data::Dumper->Dump( [ $self ], ['self'] ) ) ;
  113.  
  114.         $ENV{'SERVER_SOFTWARE'} = $PROGRAM_NAME ;
  115.  
  116.         if ( '/cgi-bin/imapsync' eq $ENV{'PATH_INFO'} ) {
  117.                 #$self->exec_trusted_perl( './imapsync' ) ;
  118.                 $self->exec_cgi( './imapsync' ) ;
  119.                 #$self->exec_cgi( './imapsync_bin_Linux_i686' ) ;
  120.                
  121.                 #$self->exec_trusted_perl( '.\imapsync.pl' );
  122.                 $self->log( 2, "In process_http_request PID $$ after exec_trusted_perl\n" ) ;
  123.                 #return ;
  124.                 #return $self->exec_cgi( 'C:\Strawberry\perl\bin\perl.exe .\imapsync.pl' );
  125.                 #return $self->exec_cgi( 'imapsyncbat' );
  126.                 #return $self->exec_trusted_perl( 'imapsyncbat' );
  127.                
  128.         }
  129.         else
  130.         {
  131.                 process_path_info( $self, $ENV{'PATH_INFO'} ) ;
  132.         }
  133.         #$self->log( 4, Data::Dumper->Dump( [ $self ], ['self'] ) ) ;
  134.         $self->log( 2, "End of process_http_request PID $$\n" ) ;
  135. }
  136.  
  137. sub file_to_string
  138. {
  139.         my $file  = shift ;
  140.         if ( ! $file ) { warn "Error, no file given\n" ; return ; }
  141.         if ( ! -e $file ) { warn "Error, $file does not exist\n" ; return ; }
  142.         if ( ! -f $file ) { warn "Error, $file is not a file\n" ; return ; }
  143.         if ( ! -r $file ) { warn "Error, $file is not readable\n" ; return ; }
  144.         my @string ;
  145.         if ( open my $FILE, '<', $file ) {
  146.                 @string = <$FILE> ;
  147.                 close $FILE ;
  148.                 my $string = join q{}, @string ;
  149.                 return $string ;
  150.         }else{
  151.                 warn "Error reading file $file : $OS_ERROR\n" ;
  152.                 return ;
  153.         }
  154. }
Raw Paste

Login or Register to edit or fork this paste. It's free.