HTTP-Server-Simple-CGI-PreFork-6/0000755000175000017500000000000012776656621015377 5ustar cavaccavacHTTP-Server-Simple-CGI-PreFork-6/MANIFEST.SKIP0000644000175000017500000000150712776655614017301 0ustar cavaccavac# Avoid version control files. \bRCS\b \bCVS\b \bSCCS\b ,v$ \B\.svn\b \B\.hg\b \B\.hgtags\b \B\.git\b \B\.gitignore\b \b_darcs\b \B\.cvsignore$ # Avoid VMS specific MakeMaker generated files \bDescrip.MMS$ \bDESCRIP.MMS$ \bdescrip.mms$ # Avoid Makemaker generated and utility files. \bMANIFEST\.bak \bMakefile$ \bblib/ \bMakeMaker-\d \bpm_to_blib\.ts$ \bpm_to_blib$ \bblibdirs\.ts$ # 6.18 through 6.25 generated this \bMYMETA\.json \bMYMETA\.yml # Avoid Module::Build generated and utility files. \bBuild$ \b_build/ \bBuild.bat$ \bBuild.COM$ \bBUILD.COM$ \bbuild.com$ # Avoid temp and backup files. ~$ \.old$ \#$ \b\.# \.bak$ \.tmp$ server/tmp.*\.html$ \.# \.rej$ \.pyc$ \.lock$ # Avoid OS-specific files/dirs # Mac OSX metadata \B\.DS_Store # Mac OSX SMB mount metadata files \B\._ # Avoid Devel::Cover files. \bcover_db\b HTTP-Server-Simple-CGI-PreFork-6/META.json0000664000175000017500000000222412776656621017022 0ustar cavaccavac{ "abstract" : "unknown", "author" : [ "Rene Schickbauer " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "HTTP-Server-Simple-CGI-PreFork", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "HTTP::Server::Simple" : "0.44", "IO::Socket::INET6" : "0", "Net::SSLeay" : "0", "Net::Server" : "2", "Net::Server::PreFork" : "0", "Net::Server::Proto::SSLEAY" : "0", "Net::Server::Single" : "0", "Socket6" : "0" } } }, "release_status" : "stable", "version" : 6 } HTTP-Server-Simple-CGI-PreFork-6/META.yml0000664000175000017500000000127012776656621016652 0ustar cavaccavac--- abstract: unknown author: - 'Rene Schickbauer ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: HTTP-Server-Simple-CGI-PreFork no_index: directory: - t - inc requires: HTTP::Server::Simple: '0.44' IO::Socket::INET6: '0' Net::SSLeay: '0' Net::Server: '2' Net::Server::PreFork: '0' Net::Server::Proto::SSLEAY: '0' Net::Server::Single: '0' Socket6: '0' version: 6 HTTP-Server-Simple-CGI-PreFork-6/MANIFEST0000644000175000017500000000054612776656621016535 0ustar cavaccavac.hgignore Changes lib/HTTP/Server/Simple/CGI/PreFork.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP t/01-compile.t t/03-pod.t t/04-podcoverage.t t/30-perlcritic.t t/perlcriticrc META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) HTTP-Server-Simple-CGI-PreFork-6/.hgignore0000644000175000017500000000013612776655614017203 0ustar cavaccavacserver/websocket.pyc server/tmp.*html$ MANIFEST.bak server/webgui.lock server/webgui_ssl.lock HTTP-Server-Simple-CGI-PreFork-6/Changes0000644000175000017500000000201512776656413016667 0ustar cavaccavacRevision history for HSS Prefork 6.00 Mon Oct 10 11:00:00 2016 - HTTPS bugfix by Luigi Iotti 4.00 Fri Dec 14 14:08:00 2012 - Net::Server::* and HTTP::Server::Simple do not communicate the client IP address when SSL is in use. This version of HSS-Prefork fixes this by patching HTTP::Server::Simple which in turn patches Net::Server. And the IP (peername to be exact) is now handed over via $main::_realpeername. Aaaargh! (but it works...) 3.20 Fri Aug 03 13:00:00 2012 - Remove debugging output 3.10 Thu Aug 02 15:50:00 2012 - Bugfix for the Bugfix 3.00 Thu Aug 02 15:30:00 2012 - Fix for current Socket modules (Socket.pm changed default exports and broke my IPv6 handling) 2.00 Tue Jun 26 11:30:00 2012 - Adapted for Net::Server 2.0 (with full IPv6 support) 1.2 Tue Apr 17 12:00:00 2012 - Better handling of Chrome futility connections 1.1 Mon Oct 18 10:00:00 2011 - Fixed some bugs 1.00 Mon Oct 17 12:00:00 2011 - Initial version of HTTP::Server::Simple::PreFork HTTP-Server-Simple-CGI-PreFork-6/Makefile.PL0000644000175000017500000000156512776656553017364 0ustar cavaccavacuse 5.010000; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'HTTP::Server::Simple::CGI::PreFork', VERSION_FROM => 'lib/HTTP/Server/Simple/CGI/PreFork.pm', # finds $VERSION PREREQ_PM => { "HTTP::Server::Simple" => 0.44, "IO::Socket::INET6" => 0, "Socket6" => 0, "Net::Server" => 2, "Net::Server::PreFork" => 0, "Net::Server::Single" => 0, "Net::Server::Proto::SSLEAY" => 0, "Net::SSLeay" => 0, }, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (#ABSTRACT_FROM => 'lib/Maplat/ProdIT.pm', # retrieve abstract from module AUTHOR => 'Rene Schickbauer ') : ()), ); HTTP-Server-Simple-CGI-PreFork-6/lib/0000755000175000017500000000000012776656621016145 5ustar cavaccavacHTTP-Server-Simple-CGI-PreFork-6/lib/HTTP/0000755000175000017500000000000012776656621016724 5ustar cavaccavacHTTP-Server-Simple-CGI-PreFork-6/lib/HTTP/Server/0000755000175000017500000000000012776656621020172 5ustar cavaccavacHTTP-Server-Simple-CGI-PreFork-6/lib/HTTP/Server/Simple/0000755000175000017500000000000012776656621021423 5ustar cavaccavacHTTP-Server-Simple-CGI-PreFork-6/lib/HTTP/Server/Simple/CGI/0000755000175000017500000000000012776656621022025 5ustar cavaccavacHTTP-Server-Simple-CGI-PreFork-6/lib/HTTP/Server/Simple/CGI/PreFork.pm0000644000175000017500000004640512776656313023742 0ustar cavaccavacpackage HTTP::Server::Simple::CGI::PreFork; use strict; use warnings; use Socket ':all'; use IO::Handle; #use Socket6 qw[unpack_sockaddr_in6]; our $VERSION = 6.0; use Carp; use base qw[HTTP::Server::Simple::CGI]; sub run { my ($self, %config) = @_; if(!defined($config{prefork})) { $config{prefork} = 0; } if(!defined($config{usessl})) { $config{usessl} = 0; } if($config{prefork}) { # Create new subroutine to tell HTTP::Server::Simple that we want # to be a preforking server no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitNoStrict) *{__PACKAGE__ . "::net_server"} = sub { my $server = 'Net::Server::PreFork'; return $server; }; } else { no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitNoStrict) *{__PACKAGE__ . "::net_server"} = sub { my $server = 'Net::Server::Single'; return $server; }; } # SET UP FOR SSL if($config{usessl}) { # SET UP FOR SSL # we need to ovverride the _process_request sub for IPv6. For SSL, we # also need to disable the calls to binmode no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitNoStrict) *{__PACKAGE__ . "::_process_request"} = sub { my $self = shift; # Create a callback closure that is invoked for each incoming request; # the $self above is bound into the closure. sub { $self->stdio_handle(*STDIN) unless $self->stdio_handle; # Default to unencoded, raw data out. # if you're sending utf8 and latin1 data mixed, you may need to override this #binmode STDIN, ':raw'; #binmode STDOUT, ':raw'; my $remote_sockaddr = getpeername( $self->stdio_handle ); if(!$remote_sockaddr && defined($main::_realpeername)) { $remote_sockaddr = $main::_realpeername; } my ( $iport, $iaddr, $peeraddr ); if($remote_sockaddr) { eval { # Be fully backwards compatible ( $iport, $iaddr ) = sockaddr_in($remote_sockaddr); $peeraddr = $iaddr ? ( inet_ntoa($iaddr) || "127.0.0.1" ) : '127.0.0.1'; 1; } or do { # Handle cases where the $remote_sockaddr is an IPv6 structure eval { ( $iport, $iaddr ) = unpack_sockaddr_in6($remote_sockaddr); $peeraddr = inet_ntop(AF_INET6, $iaddr); 1; } or do { # What is the best way to handle an unparseable $remote_sockaddr? # Will IPv6 be the "old protocol" one day in our lifetime to be superceded # by something even more complex? # # For now, just return "127.0.0.1", which itself is problematic: What # about the time IPv4 gets switched off and some backend will croak because # the IP is too short? $peeraddr = "127.0.0.1"; } } } if(!defined($peeraddr)) { $peeraddr = ""; } elsif($peeraddr =~ /^\:\:ffff\:(\d+)\./) { # Looks like a IPv4 adress in IPv6 format (e.g. ::ffff:192.168.0.1 # turn it into an IPv4 address for backward compatibility $peeraddr =~ s/^\:\:ffff\://; } my ( $method, $request_uri, $proto ) = $self->parse_request; unless ($self->valid_http_method($method) ) { $self->bad_request; return; } $proto ||= "HTTP/0.9"; my ( $file, $query_string ) = ( $request_uri =~ /([^?]*)(?:\?(.*))?/s ); # split at ? $self->setup( method => $method, protocol => $proto, query_string => ( defined($query_string) ? $query_string : '' ), request_uri => $request_uri, path => $file, localname => $self->host, localport => $self->port, peername => $peeraddr, peeraddr => $peeraddr, peerport => $iport, ); # HTTP/0.9 didn't have any headers (I think) my %xheaders; if ( $proto =~ m{HTTP/(\d(\.\d)?)$} and $1 >= 1 ) { my $headers = $self->parse_headers or do { $self->bad_request; return }; %xheaders = (@$headers); $self->headers($headers); } my $do_continue = 1; if(defined($xheaders{Expect} && $xheaders{Expect} =~ /100\-continue/i)) { $do_continue = $self->handle_continue_header(%xheaders); flush STDOUT; } if($do_continue) { $self->post_setup_hook if $self->can("post_setup_hook"); $self->handler; } } } } else { # SET UP FOR NON-SSL # we need to ovverride the _process_request sub for IPv6. no strict 'refs'; ## no critic (TestingAndDebugging::ProhibitNoStrict) *{__PACKAGE__ . "::_process_request"} = sub { my $self = shift; # Create a callback closure that is invoked for each incoming request; # the $self above is bound into the closure. sub { $self->stdio_handle(*STDIN) unless $self->stdio_handle; # Default to unencoded, raw data out. # if you're sending utf8 and latin1 data mixed, you may need to override this binmode STDIN, ':raw'; binmode STDOUT, ':raw'; my $remote_sockaddr = getpeername( $self->stdio_handle ); if(!$remote_sockaddr && defined($main::_realpeername)) { $remote_sockaddr = $main::_realpeername; } my ( $iport, $iaddr, $peeraddr ); if($remote_sockaddr) { eval { # Be fully backwards compatible ( $iport, $iaddr ) = sockaddr_in($remote_sockaddr); $peeraddr = $iaddr ? ( inet_ntoa($iaddr) || "127.0.0.1" ) : '127.0.0.1'; 1; } or do { # Handle cases where the $remote_sockaddr is an IPv6 structure #print STDERR $@ . "\n"; eval { ( $iport, $iaddr ) = unpack_sockaddr_in6($remote_sockaddr); $peeraddr = inet_ntop(AF_INET6, $iaddr); 1; } or do { #print STDERR $@ . "\n"; # What is the best way to handle an unparseable $remote_sockaddr? # Will IPv6 be the "old protocol" one day in our lifetime to be superceded # by something even more complex? # # For now, just return "127.0.0.1", which itself is problematic: What # about the time IPv4 gets switched off and some backend will croak because # the IP is too short? $peeraddr = "127.0.0.1"; } } } if(!defined($peeraddr)) { $peeraddr = ""; } elsif($peeraddr =~ /^\:\:ffff\:(\d+)\./) { # Looks like a IPv4 adress in IPv6 format (e.g. ::ffff:192.168.0.1 # turn it into an IPv4 address for backward compatibility $peeraddr =~ s/^\:\:ffff\://; } my ( $method, $request_uri, $proto ) = $self->parse_request; unless ($self->valid_http_method($method) ) { $self->bad_request; return; } $proto ||= "HTTP/0.9"; # Google-Chrome, Chromium and others sometimes make "futility connections", e.g. # they open a connection, do nothing and just close the connection after a few seconds if(!defined($request_uri) || $request_uri eq '') { $self->bad_request; return; } my ( $file, $query_string ) = ( $request_uri =~ /([^?]*)(?:\?(.*))?/s ); # split at ? $self->setup( method => $method, protocol => $proto, query_string => ( defined($query_string) ? $query_string : '' ), request_uri => $request_uri, path => $file, localname => $self->host, localport => $self->port, peername => $peeraddr, peeraddr => $peeraddr, peerport => $iport, ); # HTTP/0.9 didn't have any headers (I think) my %xheaders; if ( $proto =~ m{HTTP/(\d(\.\d)?)$} and $1 >= 1 ) { my $headers = $self->parse_headers or do { $self->bad_request; return }; %xheaders = (@$headers); $self->headers($headers); } my $do_continue = 1; if(defined($xheaders{Expect} && $xheaders{Expect} =~ /100\-continue/i)) { $do_continue = $self->handle_continue_header(%xheaders); flush STDOUT; } if($do_continue) { $self->post_setup_hook if $self->can("post_setup_hook"); $self->handler; } } } } # Ok now fix broken Net::Server*SSL* handling by putting the the SSL options into ARGV my @ssl_args = qw( SSL_server SSL_use_cert SSL_verify_mode SSL_key_file SSL_cert_file SSL_ca_path SSL_ca_file SSL_cipher_list SSL_passwd_cb SSL_error_callback SSL_max_getline_length ); foreach my $ssl_arg (@ssl_args) { if(defined($config{$ssl_arg})) { push @ARGV, '--' . $ssl_arg . "=" . $config{$ssl_arg}; } } # Don't call super, just do out stuff here, as we need some changes anyway #return $self->SUPER::run(%config); # Call parent run() #*{__PACKAGE__ . "::_process_request"} = sub { { my $server = $self->net_server; local $SIG{CHLD} = 'IGNORE'; # reap child processes # $pkg is generated anew for each invocation to "run" # Just so we can use different net_server() implementations # in different runs. my $pkg = join '::', ref($self), "NetServer"; my $thispkg = ref($self); no strict 'refs'; *{"$pkg\::process_request"} = $self->_process_request; if ($server) { require join( '/', split /::/, $server ) . '.pm'; *{"$pkg\::ISA"} = [$server]; # clear the environment before every request require HTTP::Server::Simple::CGI; *{"$pkg\::post_accept"} = sub { HTTP::Server::Simple::CGI::Environment->setup_environment; $config{usessl} and $ENV{'HTTPS'} = 'on'; # Required by CGI spec. Also needed for CGI.pm to return 'on' (and not undef) in https() and to return https:// and not http:// links in url(). # $self->SUPER::post_accept uses the wrong super package $server->can('post_accept')->(@_); }; *{"$pkg\::post_accept_hook"} = sub { my ($xself) = @_; $main::_realpeername = $xself->{server}->{peername}; }; } else { $self->setup_listener; $self->after_setup_listener(); *{"$pkg\::run"} = $self->_default_run; } #local $SIG{HUP} = sub { $SERVER_SHOULD_RUN = 0; }; $pkg->run( port => $self->port, @_ ); }; } sub handle_continue_header { my ($self, %headers) = @_; my $continue = 1; print "HTTP/1.1 100 Continue\r\n"; return $continue; } 1; __END__ =head1 NAME HTTP::Server::Simple::CGI::PreFork - Turn HSS into a preforking webserver and enable SSL =head1 SYNOPSIS Are you using HTTP::Server::Simple::CGI (or are you planning to)? But you want to handle multiple connections at once and even try out this SSL thingy everyone is using these days? Fear not, the (brilliant) HTTP::Server::Simple::CGI is easy to extend and this (only modestly well-designed) module does it for you. HTTP::Server::Simple::CGI::PreFork should be fully IPv6 compliant. =head1 DESCRIPTION This module is a plugin module for the "Commands" module and handles PostgreSQL admin commands scheduled from the WebGUI. =head1 Configuration Obviously, you want to read the HTTP::Server::Simple documentation for the bulk of configuration options. Since we also overload the base tcp connection class with Net::Server, you might also want to read the documentation for that. We use two Net::Server classes, depending on if we are preforking or single threaded: Net::Server::Single for singlethreaded Net::Server::PreFork for multithreaded In addition to the HTTP::Server::Simple configuration, there are only two additional options (in the hash to) the run() method: usessl and prefork. =head2 prefork Basic usage: $myserver->run(prefork => 1): Per default, prefork is turned off (e.g. server runs singlethreaded). This is very usefull for debugging and backward compatibility. Beware when forking: Keep in mind how database and filehandles behave. Normally, you should set up everything before the run method (cache files, load confiugurations,...), then close all handles and run(). Then, depending on your site setup, either open a database connection for every request and close it again, or (and this is the better performing option) open a database handle at every request you don't have an open handle yet - since we are forking, every thread get's its own unique handle while not constantly opening and closing the handles. Optionally, you can also add all the different options of Net::Server::Prefork like "max_servers" on the call to run() to optimize your configuration. =head2 usessl Caution: SSL support is experimental at best. I got this to work with a lot of warnings, sometimes it might not work at all. If you use this, please send patches! Set this option to 1 if you want to use SSL (default is off). For SSL to actually work, need to add some extra options (required for the underlying Net::Server classes, something like this usually does the trick: $webserver->run(usessl => 1, proto => 'ssleay', "--SSL_key_file"=> 'mysite.key', "--SSL_cert_file"=>'mysite.crt', ); =head2 run Internal functions that overrides the HTTP::Server::Simple::CGI run function. Just as explained above. =head2 handle_continue_header Overrideable function that allows to to custom-handle the "100 Continue" status codes. This function is called if the client sends a a "Expect: 100-continue" header. It defaults to sending a "100 Continue" status line and proceed with the rest of the request. If you want to override this, for example to check upload size or permissions, subclass this function. You will recieve the headers as a hash as the only input (nothing much else has been parsed from the client as of this moment in time). It is your job to send/print the appropriate status line header, either "100 Continue" or the appropriate error code. Return true if you want HSS::Prefork to continue data transfer and finish setting up the CGI environment for the request or false to abort. BEWARE: Since only the headers have been parsed at this point of time, you don't have the full CGI kaboodle at your disposal. The way HSS:Prefork overrides the base modules, the internal setup phase is not complete and you should only use the headers provided to make a basic decision if you want to continue and make a full check later (permissions, client IP, whatever) on, just as you would when the client wouldn't have send the Expect-Header =head1 IPv6 This module overrides also the pure IPv4 handling of HTTP::Server::Simple::CGI and turns it into an IPv4/IPv6 multimode server. Only caveat here is, that you need the Net::Server modules in version 2.0 or higher. If you still use Net::Server 0.99.6.*, you should install HTTP::Server::Simple::CGI::PreFork 1.2 from BackPan. Net::Server version 0.99 and lower only supports IPv4. =head1 Possible incompatibilities with your computer Older versions of HSSC::Prefork did not automatically require the IPv6 modules on installation. This behaviour has changed, starting at version 2.0. This is in accordance with with RFC6540, titled "IPv6 Support Required for All IP-Capable Nodes". If you don't have an IPv6 address, thats OK (or more precisely *your* problem). But the software now assumes that your system is technicaly capable of handling IPv6 connections, even if you don't have an IPv6 uplink at the moment. Doing it this way simplifies many future tasks. Anyway, if your system is old enough to be incapable of handling IPv6... according to RFC6540 you are not connected to what is nowadays defined as "the internet". =head1 QUICK-HACK-WARNING This module "patches" HTTP::Server::Simple by overloading one of the functions. Updating HTTP::Server::Simple *might* break something. While this is not very likely, make sure to test updates before updating a production system! =head1 AUTHOR Rene Schickbauer, Ecavac@cpan.orgE This module borrows heavily from the follfowing modules: HTTP::Server::Simple by Jesse Vincent Net::Server by Paul T. Seamons HTTPS bugfix for version 6 by Luigi Iotti =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.10.0 or, at your option, any later version of Perl 5 you may have available. =head1 THANKS Special thanks to Jesse Vincent for giving me quick feedback when i needed it. Also thanks to the countless PerlMonks helping me out when i'm stuck. This module is dedicated to you! =cut HTTP-Server-Simple-CGI-PreFork-6/t/0000755000175000017500000000000012776656621015642 5ustar cavaccavacHTTP-Server-Simple-CGI-PreFork-6/t/01-compile.t0000644000175000017500000000142612776655614017701 0ustar cavaccavac# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Maplat.t' use strict; use warnings; ######################### # There is currently a problem under Windows with Date::Manip on # certain non-english installations of XP (and possible others). # # So we set our time zone to CET BEGIN { if(!defined($ENV{TZ})) { $ENV{TZ} = "CET"; } } ######################### # change 'tests => 1' to 'tests => last_test_to_print'; use Test::More tests => 1; BEGIN { use_ok('HTTP::Server::Simple::CGI::PreFork'); }; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. HTTP-Server-Simple-CGI-PreFork-6/t/30-perlcritic.t0000644000175000017500000000206512776655614020413 0ustar cavaccavacuse strict; use warnings; use File::Spec; use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; use Data::Dumper; use English qw(-no_match_vars); if ( not $ENV{TEST_CRITIC} ) { my $msg = 'Perl::Critic test. Set $ENV{TEST_CRITIC} to a true value to run.'; plan( skip_all => $msg ); } eval { require Test::Perl::Critic; }; if ( $EVAL_ERROR ) { my $msg = 'Test::Perl::Critic required to criticise code'; plan( skip_all => $msg ); } my @modules = all_modules(); my $tests = 0; my @fnames; foreach my $module (@modules) { next if($module =~ /Cache::Memcached/); my $fname = 'lib/' . $module . '.pm'; $fname =~ s/\:\:/\//go; $tests++; push @fnames, $fname; } plan(tests => $tests); my $rcfile = File::Spec->catfile( 't', 'perlcriticrc' ); Test::Perl::Critic->import( -profile => $rcfile, -verbose => "[%p] %m at line %l, column %c. (Severity: %s)\n %e\n"); #all_critic_ok(); foreach my $fname (@fnames) { #diag "** $fname"; critic_ok($fname); } HTTP-Server-Simple-CGI-PreFork-6/t/03-pod.t0000644000175000017500000000035412776655614017034 0ustar cavaccavac#!/usr/bin/perl -w # This test will currently fail due to incorrect POD tags use strict; use warnings; use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); HTTP-Server-Simple-CGI-PreFork-6/t/04-podcoverage.t0000644000175000017500000000261212776655614020550 0ustar cavaccavac#!/usr/bin/perl -w use strict; use warnings; use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; #all_pod_coverage_ok({ also_private => [ '/^[A-Z_]+$/' ], }); my @modules = all_modules(); my @web; my @worker; my @helpers; my @other; my $tests = 0; foreach my $module (@modules) { if($module =~ /\:\:Worker\:\:/ && $module !~ /BaseModule/) { push @worker, $module; $tests++; } elsif($module =~ /\:\:Web\:\:/ && $module !~ /BaseModule/) { push @web, $module; $tests++; } elsif($module =~ /\:\:Helpers\:\:Cache/) { # Ignore local workaround clone } elsif($module =~ /\:\:Helpers\:\:/) { push @helpers, $module; $tests++; } else { push @other, $module; $tests++; } } plan tests => $tests; # General modules foreach my $module (@other) { pod_coverage_ok($module); } foreach my $module (@helpers) { my $trustparents = { coverage_class => 'Pod::Coverage::CountParents' }; pod_coverage_ok( $module, $trustparents ); } # Worker modules foreach my $module (@worker) { my $trustparents = { coverage_class => 'Pod::Coverage::CountParents' }; pod_coverage_ok( $module, $trustparents ); } # Web modules foreach my $module (@web) { my $trustparents = { coverage_class => 'Pod::Coverage::CountParents', }; pod_coverage_ok( $module, $trustparents ); } done_testing(); HTTP-Server-Simple-CGI-PreFork-6/t/perlcriticrc0000644000175000017500000000735312776655614020263 0ustar cavaccavac# Basic setup severity = 3 verbose = 8 # Prohibit indirect syntax of "new", "create" and "destroy" # Should we add "connect" (DBI) as well? [Objects::ProhibitIndirectSyntax] severity = 4 forbid = create destroy connect # Stop gap measure - FIXME [RegularExpressions::RequireExtendedFormatting] minimum_regex_length_to_complain_about = 40 # Maplat is a highly complex project. Splitting # everything into multiple subroutines just makes matters worse [Subroutines::ProhibitExcessComplexity] max_mccabe = 67 # This policy would force constructs that will prohibit simple # copy&paste (used in all the SQL strings where c&p between perl code and some SQL # window are the most efficient form of editing. # The alternative would be HEREDOC's. They will break the code flow and are more # akward to implement. I'll maybe do this later... for now, just use implicit newlines # because they get ignored by the SQL parsers anyway... # # So we don't forget, we set a severety level that's not yet checked [Perl::Critic::Policy::ValuesAndExpressions::ProhibitImplicitNewlines] severity = 2 # When writing commercial applications, the default is somewhat conservative [Subroutines::ProhibitManyArgs] max_arguments = 8 # There are a few cases where deep nests are the best alternative # from a basket of bad possibilities [ControlStructures::ProhibitDeepNests] max_nests = 9 # Too brief open forces memory slurping. Not nice for files # where the size isn't known in advance [InputOutput::RequireBriefOpen] lines = 20 # RCS Keywords are outdated. They mess up patch-files (see "Updating # FreeBSD from Source" as a prime example why NOT to use them these days) # and they are also discouraged by the mercurial team. [-Perl::Critic::Policy::Miscellanea::RequireRcsKeywords] # POD documentation has a rather low priority in this project. Set severety to the # lowest level [Perl::Critic::Policy::Documentation::RequirePodSections] severity = 1 # This is a web project. HTTP status codes aren't undocumented "magic numbers", they are *very* # well defined in RFC2612. It just doesn't make sense to use them as named variables by default. In fact, # it might be much worse [ValuesAndExpressions::ProhibitMagicNumbers] allowed_values = 0 1 2 100 101 200 201 202 203 204 205 206 300 301 302 303 304 305 306 307 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 500 501 502 503 504 505 # I disagree with this policy. If you look into the examples given by # the manual of this very same policy, the regex are easy to read whereas # the alternatives are jumbled character soup. # Also performance is *not* an issue as long as you use /o #[-Perl::Critic::Policy::RegularExpressions::ProhibitFixedStringMatches] # I like perls matching behaviour just as it is, thank you very much [-Perl::Critic::Policy::RegularExpressions::RequireLineBoundaryMatching] [-RegularExpressions::RequireDotMatchAnything] # Whats that about Conway and his dislike of PostfixControls? Sure, you # have to be a bit carefull when and where to use them. But *i* like and use # them because there are instances they make the code more readable to *me*. # And since i seems to be the only one who actually does any work on this project, # i might as well use my own styleguide... #[-ControlStructures::ProhibitPostfixControls] # "unless" in its block form is *really* bad. Bump it up to a more # reasonable error level #[Perl::Critic::Policy::ControlStructures::ProhibitUnlessBlocks] #severity = 4 # What the...? q{} is more readable than '' for empty strings??? No, not in my world. [-ValuesAndExpressions::ProhibitEmptyQuotes] # The same goes for "noisy" quotes [-ValuesAndExpressions::ProhibitNoisyQuotes] # Force "use English" to behave properly [Perl::Critic::Policy::Modules::RequireNoMatchVarsWithUseEnglish] severity = 4