Hello community, here is the log from the commit of package perl-Net-Server checked in at Fri Mar 30 16:31:44 CEST 2007. -------- --- perl-Net-Server/perl-Net-Server.changes 2007-02-14 14:14:22.000000000 +0100 +++ /mounts/work_src_done/STABLE/perl-Net-Server/perl-Net-Server.changes 2007-03-30 16:12:48.000000000 +0200 @@ -1,0 +2,14 @@ +Fri Mar 30 15:59:52 CEST 2007 - anicka@suse.cz + +- update to 0.96 + * Allow for conf_file to be specified in the default_values. + * Add perldoc for why we use a template in options. + * Fix syslog log options regex again (Carlos Velasco) + * Fix ->autoflush (needs FileHandle) + * Add handle_syslog_error to allow catching errors + during syslog writes + * Add open_syslog to slightly abstract opening of syslog. + * Add numerous patches to cleanup child accounting in PreFork + server. + +------------------------------------------------------------------- Old: ---- Net-Server-0.95.tar.bz2 New: ---- Net-Server-0.96.tar.bz2 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-Net-Server.spec ++++++ --- /var/tmp/diff_new_pack.P30591/_old 2007-03-30 16:31:39.000000000 +0200 +++ /var/tmp/diff_new_pack.P30591/_new 2007-03-30 16:31:39.000000000 +0200 @@ -1,5 +1,5 @@ # -# spec file for package perl-Net-Server (Version 0.95) +# spec file for package perl-Net-Server (Version 0.96) # # Copyright (c) 2007 SUSE LINUX Products GmbH, Nuernberg, Germany. # This file and all modifications and additions to the pristine @@ -17,7 +17,7 @@ Requires: perl = %{perl_version} Autoreqprov: on Summary: Net::Server - Extensible, general Perl server engine -Version: 0.95 +Version: 0.96 Release: 1 Source: Net-Server-%{version}.tar.bz2 Requires: perl-IO-Multiplex @@ -62,7 +62,18 @@ %{perl_vendorarch}/auto/Net/Server /var/adm/perl-modules/perl-Net-Server -%changelog -n perl-Net-Server +%changelog +* Fri Mar 30 2007 - anicka@suse.cz +- update to 0.96 + * Allow for conf_file to be specified in the default_values. + * Add perldoc for why we use a template in options. + * Fix syslog log options regex again (Carlos Velasco) + * Fix ->autoflush (needs FileHandle) + * Add handle_syslog_error to allow catching errors + during syslog writes + * Add open_syslog to slightly abstract opening of syslog. + * Add numerous patches to cleanup child accounting in PreFork + server. * Wed Feb 14 2007 - anicka@suse.cz - update to 0.95 - Warn clean on the chld hanlder in PreFork. ++++++ Net-Server-0.95.tar.bz2 -> Net-Server-0.96.tar.bz2 ++++++ diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-Server-0.95/Changes new/Net-Server-0.96/Changes --- old/Net-Server-0.95/Changes 2007-02-03 08:19:23.000000000 +0100 +++ new/Net-Server-0.96/Changes 2007-03-23 23:22:29.000000000 +0100 @@ -1,5 +1,14 @@ Revision history for Perl extension Net::Server. +0.96 Mar 23 2007 + - Allow for conf_file to be specified in the default_values. + - Add perldoc for why we use a template in options. + - Fix syslog log options regex again (Carlos Velasco) + - Fix ->autoflush (needs FileHandle) (Paul Miller) + - Add handle_syslog_error to allow catching errors during syslog writes (Patrik Wallstrom) + - Add open_syslog to slightly abstract opening of syslog. + - Add numerous patches from Rob Mueller to cleanup child accounting in PreFork server. + 0.95 Feb 02 2007 - Warn clean on the chld hanlder in PreFork. (Michael Virnstein) - Allow lock_file for lock serialization to only be opened once (Rob Mueller) diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-Server-0.95/lib/Net/Server/PreFork.pm new/Net-Server-0.96/lib/Net/Server/PreFork.pm --- old/Net-Server-0.95/lib/Net/Server/PreFork.pm 2007-02-03 06:38:32.000000000 +0100 +++ new/Net-Server-0.96/lib/Net/Server/PreFork.pm 2007-03-23 23:21:51.000000000 +0100 @@ -2,7 +2,7 @@ # # Net::Server::PreFork - Net::Server personality # -# $Id: PreFork.pm,v 1.34 2007/02/03 05:38:32 rhandom Exp $ +# $Id: PreFork.pm,v 1.35 2007/03/23 22:21:51 rhandom Exp $ # # Copyright (C) 2001-2007 # @@ -118,6 +118,7 @@ ### get ready for children $prop->{child_select} = IO::Select->new(\*_READ); $prop->{children} = {}; + $prop->{reaped_children} = {}; if ($ENV{HUP_CHILDREN}) { my %children = map {/^(\w+)$/; $1} split(/\s+/, $ENV{HUP_CHILDREN}); $children{$_} = {status => $children{$_}, hup => 1} foreach keys %children; @@ -155,14 +156,18 @@ $self->log(3,"Killing \"$n\" children"); - foreach my $child (keys %{ $prop->{children} }){ - next unless $prop->{children}->{$child}->{status} eq 'waiting'; + foreach my $pid (keys %{ $prop->{children} }){ + # Only kill waiting children + # XXX: This is race condition prone as the child may have + # started handling a connection, but will have to do for now + my $child = $prop->{children}->{$pid}; + next unless $child->{status} eq 'waiting'; $n--; ### try to kill the child - if (! kill('HUP', $child)) { - $self->delete_child($child); + if (! kill('HUP', $pid)) { + $self->delete_child($pid); } last if $n <= 0; @@ -244,6 +249,10 @@ $prop->{SigHUPed} = 1; }; + # Open in child at start + open($prop->{lock_fh}, ">$prop->{lock_file}") + || $self->fatal("Couldn't open lock file \"$prop->{lock_file}\"[$!]"); + $self->log(4,"Child Preforked ($$)\n"); delete $prop->{$_} foreach qw(children tally last_start last_process); @@ -305,9 +314,8 @@ CHLD => sub { while ( defined(my $chld = waitpid(-1, WNOHANG)) ){ last unless $chld > 0; - $prop->{tally}->{time} = 0 if $prop->{children}->{$chld}->{hup}; - $prop->{tally}->{$prop->{children}->{$chld}->{status}}-- if $prop->{children}->{$chld}->{status}; - $self->delete_child( $chld ); + # We'll deal with this in coordinate_children to avoid a race + $self->{reaped_children}->{$chld} = 1; } }, ### uncomment this area to allow SIG USR1 to give some runtime debugging @@ -350,19 +358,29 @@ next unless $line =~ /^(\d+)\ +(waiting|processing|dequeue|exiting)$/; my ($pid,$status) = ($1,$2); - ### record the status - $prop->{children}->{$pid}->{status} = $status - if $status ne 'exiting'; - - if( $status eq 'processing' ){ - $prop->{tally}->{processing} ++; - $prop->{last_process} = time(); - - }elsif( $status eq 'waiting' ){ - $prop->{tally}->{processing} --; + # Check child details still exist + if (my $child = $prop->{children}->{$pid}) { - }elsif( $status eq 'exiting' ){ - $self->delete_child($pid); + # Delete child if it tells us it's exiting + if ($status eq 'exiting') { + $self->delete_child($pid); + + # Changing state + } else { + + # Decrement tally of state pid was in (plus sanity check) + my $old_status = $child->{status} + || $self->log(2, "No status for $pid when changing to $status\n"); + --$prop->{tally}->{$old_status} >= 0 + || $self->log(2, "Tally for $status < 0 changing pid $pid from $old_status to $status\n"); + + # Set child status and increment tally + $child->{status} = $status; + ++$prop->{tally}->{$status}; + + $prop->{last_process} = time() + if $status eq 'processing'; + } } ### user defined handler @@ -386,6 +404,17 @@ my $prop = $self->{server}; my $time = time(); + ### deleted SIG{CHLD} repeaped children + foreach my $pid (keys %{ $self->{reaped_children} }) { + # delete each pid one by one to avoid another race + delete $self->{reaped_children}->{$pid}; + + # Only delete if not already deleted + next if ! $prop->{children}->{$pid}; + + $self->delete_child($pid); + } + ### re-tally the possible types (only twice a minute) ### this might not be even necessary but is a nice sanity check if( $time - $prop->{tally}->{time} > 30 ){ @@ -479,14 +508,20 @@ my $prop = $self->{server}; my $pid = shift; + my $child = $prop->{children}->{$pid}; + if (! $child) { + $self->log(2, "Attempt to delete already deleted child $pid\n"); + return; + } + # Already gone? return if ! exists $prop->{children}->{$pid}; - my $status = $prop->{children}->{$pid}->{status} + my $status = $child->{status} || $self->log(2, "No status for $pid when deleting child\n"); --$prop->{tally}->{$status} >= 0 || $self->log(2, "Tally for $status < 0 deleting pid $pid\n"); - $prop->{tally}->{time} = 0 if $prop->{children}->{$pid}->{hup}; + $prop->{tally}->{time} = 0 if $child->{hup}; $self->SUPER::delete_child($pid); } diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-Server-0.95/lib/Net/Server/PreForkSimple.pm new/Net-Server-0.96/lib/Net/Server/PreForkSimple.pm --- old/Net-Server-0.95/lib/Net/Server/PreForkSimple.pm 2007-02-03 09:00:56.000000000 +0100 +++ new/Net-Server-0.96/lib/Net/Server/PreForkSimple.pm 2007-03-26 16:32:05.000000000 +0200 @@ -2,7 +2,7 @@ # # Net::Server::PreForkSimple - Net::Server personality # -# $Id: PreForkSimple.pm,v 1.26 2007/02/03 08:00:56 rhandom Exp $ +# $Id: PreForkSimple.pm,v 1.29 2007/03/26 14:32:05 rhandom Exp $ # # Copyright (C) 2001-2007 # @@ -96,8 +96,6 @@ $prop->{lock_file} = POSIX::tmpnam(); $prop->{lock_file_unlink} = 1; } - open($prop->{lock_fh}, ">$prop->{lock_file}") - || $self->fatal("Couldn't open lock file \"$prop->{lock_file}\"[$!]"); ### set up semaphore }elsif( $prop->{serialize} eq 'semaphore' ){ @@ -201,6 +199,10 @@ $prop->{SigHUPed} = 1; }; + # Open in child at start + open($prop->{lock_fh}, ">$prop->{lock_file}") + || $self->fatal("Couldn't open lock file \"$prop->{lock_file}\"[$!]"); + $self->log(4,"Child Preforked ($$)\n"); delete $prop->{children}; diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-Server-0.95/lib/Net/Server.pm new/Net-Server-0.96/lib/Net/Server.pm --- old/Net-Server-0.95/lib/Net/Server.pm 2007-02-03 08:54:48.000000000 +0100 +++ new/Net-Server-0.96/lib/Net/Server.pm 2007-03-23 19:39:48.000000000 +0100 @@ -2,7 +2,7 @@ # # Net::Server - Extensible Perl internet server # -# $Id: Server.pm,v 1.105 2007/02/03 07:54:48 rhandom Exp $ +# $Id: Server.pm,v 1.112 2007/03/23 18:39:48 rhandom Exp $ # # Copyright (C) 2001-2007 # @@ -30,13 +30,14 @@ use IO::Select (); use POSIX (); use Fcntl (); +use FileHandle; use Net::Server::Proto (); use Net::Server::Daemonize qw(check_pid_file create_pid_file get_uid get_gid set_uid set_gid safe_fork ); -$VERSION = '0.95'; +$VERSION = '0.96'; ###----------------------------------------------------------------### @@ -221,6 +222,12 @@ ### do a config file if( defined $prop->{conf_file} ){ $self->process_conf( $prop->{conf_file}, $template ); + } else { + ### look for a default conf_file + my $def = $self->default_values || {}; + if ($def->{conf_file}) { + $self->process_conf( $def->{conf_file}, $template ); + } } } @@ -245,34 +252,7 @@ ### log to syslog }elsif( $prop->{log_file} eq 'Sys::Syslog' ){ - my $logsock = defined($prop->{syslog_logsock}) - ? $prop->{syslog_logsock} : 'unix'; - $prop->{syslog_logsock} = ($logsock =~ /^(unix|inet|stream)$/) - ? $1 : 'unix'; - - my $ident = defined($prop->{syslog_ident}) - ? $prop->{syslog_ident} : 'net_server'; - $prop->{syslog_ident} = ($ident =~ /^([\ -~]+)$/) - ? $1 : 'net_server'; - - require Sys::Syslog; - - my $opt = defined($prop->{syslog_logopt}) - ? $prop->{syslog_logopt} : $Sys::Syslog::VERSION ge '0.15' ? 'pid,nofatal' : 'pid'; - $prop->{syslog_logopt} = ($opt =~ /^((cons|ndelay|nowait|pid|nofatal)($|[,|]))*/) - ? $1 : 'pid'; - - my $fac = defined($prop->{syslog_facility}) - ? $prop->{syslog_facility} : 'daemon'; - $prop->{syslog_facility} = ($fac =~ /^((\w+)($|\|))*/) - ? $1 : 'daemon'; - - Sys::Syslog::setlogsock($prop->{syslog_logsock}) || die "Syslog err [$!]"; - if( ! Sys::Syslog::openlog($prop->{syslog_ident}, - $prop->{syslog_logopt}, - $prop->{syslog_facility}) ){ - die "Couldn't open syslog [$!]" if $prop->{syslog_logopt} ne 'ndelay'; - } + $self->open_syslog; ### open a logging file }elsif( $prop->{log_file} && $prop->{log_file} ne 'Sys::Syslog' ){ @@ -1211,6 +1191,41 @@ ###----------------------------------------------------------### +### handle opening syslog +sub open_syslog { + my $self = shift; + my $prop = $self->{server}; + + my $logsock = defined($prop->{syslog_logsock}) + ? $prop->{syslog_logsock} : 'unix'; + $prop->{syslog_logsock} = ($logsock =~ /^(unix|inet|stream)$/) + ? $1 : 'unix'; + + my $ident = defined($prop->{syslog_ident}) + ? $prop->{syslog_ident} : 'net_server'; + $prop->{syslog_ident} = ($ident =~ /^([\ -~]+)$/) + ? $1 : 'net_server'; + + require Sys::Syslog; + + my $opt = defined($prop->{syslog_logopt}) + ? $prop->{syslog_logopt} : $Sys::Syslog::VERSION ge '0.15' ? 'pid,nofatal' : 'pid'; + $prop->{syslog_logopt} = ($opt =~ /^( (?: (?:cons|ndelay|nowait|pid|nofatal) (?:$|[,|]) )* )/x) + ? $1 : 'pid'; + + my $fac = defined($prop->{syslog_facility}) + ? $prop->{syslog_facility} : 'daemon'; + $prop->{syslog_facility} = ($fac =~ /^((\w+)($|\|))*/) + ? $1 : 'daemon'; + + Sys::Syslog::setlogsock($prop->{syslog_logsock}) || die "Syslog err [$!]"; + if( ! Sys::Syslog::openlog($prop->{syslog_ident}, + $prop->{syslog_logopt}, + $prop->{syslog_facility}) ){ + die "Couldn't open syslog [$!]" if $prop->{syslog_logopt} ne 'ndelay'; + } +} + ### how internal levels map to syslog levels $Net::Server::syslog_map = {0 => 'err', 1 => 'warning', @@ -1232,11 +1247,20 @@ $level = $Net::Server::syslog_map->{$level} || $level; } - if (@therest) { # if more parameters are passed, we must assume that the first is a format string - Sys::Syslog::syslog($level, $msg, @therest); - } else { - Sys::Syslog::syslog($level, '%s', $msg); + my $ok = eval { + if (@therest) { # if more parameters are passed, we must assume that the first is a format string + Sys::Syslog::syslog($level, $msg, @therest); + } else { + Sys::Syslog::syslog($level, '%s', $msg); + } + 1; + }; + + if (! $ok) { + my $err = $@; + $self->handle_syslog_error($err, [$level, $msg, @therest]); } + return; } else { return if $level !~ /^\d+$/ || $level > $prop->{log_level}; @@ -1245,6 +1269,11 @@ $self->write_to_log_hook($level, $msg); } +### allow catching syslog errors +sub handle_syslog_error { + my ($self, $error) = @_; + die $error; +} ### standard log routine, this could very easily be ### overridden with a syslog call diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-Server-0.95/lib/Net/Server.pod new/Net-Server-0.96/lib/Net/Server.pod --- old/Net-Server-0.95/lib/Net/Server.pod 2007-02-03 08:57:16.000000000 +0100 +++ new/Net-Server-0.96/lib/Net/Server.pod 2007-03-23 23:24:33.000000000 +0100 @@ -13,7 +13,7 @@ my $self = shift; while (<STDIN>) { s/\r?\n$//; - print "You said \"$_\"\r\n"; # basic echo + print "You said '$_'\r\n"; # basic echo last if /quit/i; } } @@ -209,7 +209,6 @@ C<Net::Server> can, or will, be included with this distribution). #!/usr/bin/perl -w -T - #--------------- file test.pl --------------- package MyPackage; @@ -224,20 +223,20 @@ my $self = shift; eval { - local $SIG{ALRM} = sub { die "Timed Out!\n" }; - my $timeout = 30; # give the user 30 seconds to type a line + local $SIG{'ALRM'} = sub { die "Timed Out!\n" }; + my $timeout = 30; # give the user 30 seconds to type some lines my $previous_alarm = alarm($timeout); - while( <STDIN> ){ + while (<STDIN>) { s/\r?\n$//; - print "You said \"$_\"\r\n"; + print "You said '$_'\r\n"; alarm($timeout); } alarm($previous_alarm); }; - if( $@=~/timed out/i ){ + if ($@ =~ /timed out/i) { print STDOUT "Timed Out.\r\n"; return; } @@ -246,29 +245,29 @@ 1; - #--------------- file test.pl --------------- - Playing this file from the command line will invoke a Net::Server using the PreFork personality. When building a server layer over the Net::Server, it is important to use -features such as timeouts to prevent Denial of Service +features such as timeouts to prevent Denial Of Service attacks. =head1 ARGUMENTS There are five possible ways to pass arguments to -Net::Server. They are I<passing on command line>, I<using a -conf file>, I<passing parameters to run>, I<returning values -in the default_values method>, or I<using a -pre-built object to call the run method> (such as that returned -by the new method). - -The C<options> method is used to determine which arguments the -server will search for. Any arguments found from the command line, -parameters passed to run, and arguments found in the conf_file will -be matched against the keys of the options template. Any commandline -parameters that do not match will be left in place and can be further -processed by the server in the various hooks (by looking at @ARGV). +Net::Server. They are I<passing to the new method>, I<passing on +command line>, I<passing parameters to run>, I<using a conf file>, +I<returning values in the default_values method>, or I<configuring the +values in post_configure_hook>. + +The C<options> method is used to determine which arguments the server +will search for and can be used to extend the parsed parameters. Any +arguments found from the command line, parameters passed to run, and +arguments found in the conf_file will be matched against the keys of +the options template. Any commandline parameters that do not match +will be left in place and can be further processed by the server in +the various hooks (by looking at @ARGV). Arguments passed to new will +automatically win over any other options (this can be used if you +would like to disallow a user passing in other arguments). Arguments consist of key value pairs. On the commandline these pairs follow the POSIX fashion of C<--key value> or @@ -280,7 +279,7 @@ a prebuilt object can best be shown in the following code: #!/usr/bin/perl -w -T - #--------------- file test2.pl --------------- + package MyPackage; use strict; use base qw(Net::Server); @@ -290,19 +289,24 @@ }); $server->run; - #--------------- file test2.pl --------------- All five methods for passing arguments may be used at the same time. Once an argument has been set, it is not over written if another method passes the same argument. C<Net::Server> will look for arguments in the following order: - 1) Arguments contained in the prebuilt object. + 1) Arguments passed to the C<new> method. 2) Arguments passed on command line. - 3) Arguments passed to the run method. + 3) Arguments passed to the C<run> method. 4) Arguments passed via a conf file. - 5) Arguments set in default_values method. - 6) Arguments set in the configure_hook. + 5) Arguments set in the C<default_values> method. + +Additionally the following hooks are available: + + 1) Arguments set in the configure_hook (occurs after new + but before any of the other areas are checked). + 2) Arguments set and validated in the post_configure_hook + (occurs after all of the other areas are checked). Each of these levels will override parameters of the same name specified in subsequent levels. For example, specifying @@ -331,7 +335,7 @@ $self->SUPER::options($template); ### add a single value option - $prop->{'my_option'} = undef; + $prop->{'my_option'} ||= undef; $template->{'my_option'} = \ $prop->{'my_option'}; ### add a multi value option @@ -339,15 +343,62 @@ $template->{'an_arrayref_item'} = $prop->{'an_arrayref_item'}; } -Overriding the C<options> method allows for adding your own custom fields. -A template hashref is passed in, that should then be modified to contain -an of your custom fields. Fields which are intended to receive a single -scalar value should have a reference to the destination scalar given. Fields -which are intended to receive multiple values should reference the corresponding -destination arrayref. - -You are responsible for validating your custom options once they have been parsed. -The post_configure_hook is a good place to do your validation. +Overriding the C<options> method allows for adding your own custom +fields. A template hashref is passed in, that should then be modified +to contain an of your custom fields. Fields which are intended to +receive a single scalar value should have a reference to the +destination scalar given. Fields which are intended to receive +multiple values should reference the corresponding destination +arrayref. + +You are responsible for validating your custom options once they have +been parsed. The post_configure_hook is a good place to do your +validation. + +Some emails have asked why we use this "template" method. The idea is +that you are creating the the data structure to store the values in, +and you are also creating a way to get the values into the data +structure. The template is the way to get the values to the servers +data structure. One of the possibilities (that probably isn't used +that much) is that by letting you specify the mapping, you could build +a nested data structure - even though the passed in arguments are +flat. It also allows you to setup aliases to your names. + +For example, a basic structure might look like this: + + $prop = $self->{'server'} + + $prop->{'my_custom_option'} ||= undef; + $prop->{'my_custom_array'} ||= []; + + $template = { + my_custom_option => \ $prop->{'my_custom_option'}, + mco => \ $prop->{'my_custom_option'}, # alias + my_custom_array => $prop->{'my_custom_array'}, + mca => $prop->{'my_custom_array'}, # an alias + }; + + $template->{'mco2'} = $template->{'mco'}; # another way to alias + +But you could also have more complex data: + + $prop = $self->{'server'}; + + $prop->{'one_layer'} = { + two_layer => [ + undef, + undef, + ], + }; + + $template = { + param1 => \ $prop->{'one_layer'}->{'two_layer'}->[0], + param2 => \ $prop->{'one_layer'}->{'two_layer'}->[1], + }; + +This is of course a contrived example - but it does show that you can +get the data from the flat passed in arguments to whatever type of +structure you need - with only a little bit of effort. =head1 DEFAULT ARGUMENTS FOR Net::Server @@ -399,6 +450,40 @@ Filename from which to read additional key value pair arguments for starting the server. Default is undef. +There are two ways that you can specify a default location for +a conf_file. The first is to pass the default value to the run +method as in: + + MyServer->run({ + conf_file => '/etc/my_server.conf', + }); + +If the end user passes in --conf_file=/etc/their_server.conf then +the value will be overridden. + +The second way to do this was added in the 0.96 version. It uses +the default_values method as in: + + sub default_values { + return { + conf_file => '/etc/my_server.conf', + } + } + +This method has the advantage of also being able to be overridden +in the run method. + +If you do not want the user to be able to specify a conf_file at +all, you can pass conf_file to the new method when creating your +object: + + MyServer->new({ + conf_file => '/etc/my_server.conf', + })->run; + +If passed this way, the value passed to new will "win" over any of +the other passed in values. + =item log_level Ranges from 0 to 4 in level. Specifies what level of error @@ -619,12 +704,12 @@ You may get and set properties in two ways. The suggested way is to access properties directly via - my $val = $self->{server}->{key1}; + my $val = $self->{server}->{key1}; -Accessing the properties directly will speed the -server process. A second way has been provided for object -oriented types who believe in methods. The second way -consists of the following methods: +Accessing the properties directly will speed the server process - +though some would deem this as bad style. A second way has been +provided for object oriented types who believe in methods. The second +way consists of the following methods: my $val = $self->get_property( 'key1' ); my $self->set_property( key1 => 'val1' ); @@ -637,7 +722,7 @@ C<Net::Server> allows for the use of a configuration file to read in server parameters. The format of this conf file is -simple key value pairs. Comments and white space are +simple key value pairs. Comments and blank lines are ignored. #-------------- file test.conf -------------- @@ -790,7 +875,8 @@ =item C<$self-E<gt>configure> This method attempts to read configurations from the commandline, -from the run method call, or from a specified conf_file. +from the run method call, or from a specified conf_file (the conf_file +may be specified by passed in parameters, or in the default_values). All of the configured parameters are then stored in the {"server"} property of the Server object. @@ -978,20 +1064,21 @@ =item C<$self-E<gt>can_read_hook()> -This hook occurs after a socket becomes readible on an accept_multi_port -request (accept_multi_port is used if there are multiple bound ports -to accept on, or if the "multi_port" configuration parameter is set to -true). This hook is intended to allow for processing of arbitrary handles -added to the IO::Select used for the accept_multi_port. These -handles could be added during the post_bind_hook. No internal support -is added for processing these handles or adding them to the IO::Socket. Care -must be used in how much occurs during the can_read_hook as a long response -time will result in the server being susceptible to DOS attacks. A return value -of true indicates that the Server should not pass the readible handle on to the -post_accept and process_request phases. +This hook occurs after a socket becomes readible on an +accept_multi_port request (accept_multi_port is used if there are +multiple bound ports to accept on, or if the "multi_port" +configuration parameter is set to true). This hook is intended to +allow for processing of arbitrary handles added to the IO::Select used +for the accept_multi_port. These handles could be added during the +post_bind_hook. No internal support is added for processing these +handles or adding them to the IO::Socket. Care must be used in how +much occurs during the can_read_hook as a long response time will +result in the server being susceptible to DOS attacks. A return value +of true indicates that the Server should not pass the readible handle +on to the post_accept and process_request phases. -It is generally suggested that other avenues be pursued for sending messages -via sockets not created by the Net::Server. +It is generally suggested that other avenues be pursued for sending +messages via sockets not created by the Net::Server. =item C<$self-E<gt>post_accept_hook()> @@ -1077,20 +1164,12 @@ }; } -=item C<$self-E<gt>new> +=item C<$self-E<gt>handle_syslog_error> -As of Net::Server 0.91 there is finally a new method. This method -takes a class name and an argument hashref as parameters. The argument -hashref becomes the "server" property of the object. - - package MyPackage; - use base qw(Net::Server); - - my $obj = MyPackage->new({port => 20201}); - - # same as - - my $obj = bless {server => {port => 20201}}, 'MyPackage'; +Called when log_file is set to 'Sys::Syslog' and an error occurs +while writing to the syslog. It is passed two arguments, the +value of $@, and an arrayref containing the arguments that +were passed to the log method when the error occured. =item C<$self-E<gt>log> @@ -1115,6 +1194,44 @@ If log_file is set to a file (other than Sys::Syslog), the message will be appended to the log file by calling the write_to_log_hook. +If the log_file is Sys::Syslog and an error occurs during write, +the handle_syslog_error method will be called and passed the +error exception. The default option of handle_syslog_error is +to die - but could easily be told to do nothing by using the following +code in your subclassed server: + + sub handle_syslog_error {} + +It the log had been closed, you could attempt to reopen it in the error +handler with the following code: + + sub handle_syslog_error { + my $self = shift; + $self->open_syslog; + } + +=item C<$self-E<gt>new> + +As of Net::Server 0.91 there is finally a new method. This method +takes a class name and an argument hashref as parameters. The argument +hashref becomes the "server" property of the object. + + package MyPackage; + use base qw(Net::Server); + + my $obj = MyPackage->new({port => 20201}); + + # same as + + my $obj = bless {server => {port => 20201}}, 'MyPackage'; + +=item C<$self-E<gt>open_syslog> + +Called during post_configure when the log_file option is set to 'Sys::Syslog'. +By default it use the parsed configuration options listed in this document. +If more custom behavior is desired, the method could be overridden and +Sys::Syslog::openlog should be called with the custom parameters. + =item C<$self-E<gt>shutdown_sockets> This method will close any remaining open sockets. This is called @@ -1159,30 +1276,30 @@ =head1 FILES - The following files are installed as part of this - distribution. +The following files are installed as part of this +distribution. - Net/Server.pm - Net/Server/Fork.pm - Net/Server/INET.pm - Net/Server/MultiType.pm - Net/Server/PreForkSimple.pm - Net/Server/PreFork.pm - Net/Server/Single.pm - Net/Server/Daemonize.pm - Net/Server/SIG.pm - Net/Server/Proto.pm - Net/Server/Proto/*.pm + Net/Server.pm + Net/Server/Fork.pm + Net/Server/INET.pm + Net/Server/MultiType.pm + Net/Server/PreForkSimple.pm + Net/Server/PreFork.pm + Net/Server/Single.pm + Net/Server/Daemonize.pm + Net/Server/SIG.pm + Net/Server/Proto.pm + Net/Server/Proto/*.pm =head1 INSTALL Download and extract tarball before running these commands in its base directory: - perl Makefile.PL - make - make test - make install + perl Makefile.PL + make + make test + make install =head1 AUTHOR @@ -1274,6 +1391,7 @@ (rt #21262). Thanks to Carlos Velasco for updating the Syslog options (rt #21265). +And for additional fixes later. Thanks to Steven Lembark for pointing out that no_client_stdout wasn't working with the Multiplex server. @@ -1291,6 +1409,12 @@ And just a general Thanks You to everybody who is using Net::Server or who has contributed fixes over the years. +Thanks to Paul Miller for some ->autoflush, FileHandle fixes. + +Thanks to Patrik Wallstrom for suggesting handling syslog errors better. + +Thanks again to Rob Mueller for more logic cleanup for child accounting in PreFork server. + =head1 SEE ALSO Please see also @@ -1310,11 +1434,12 @@ =head1 LICENSE - This package may be distributed under the terms of either the +This package may be distributed under the terms of either the + GNU General Public License or the Perl Artistic License - All rights reserved. +All rights reserved. =cut diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-Server-0.95/META.yml new/Net-Server-0.96/META.yml --- old/Net-Server-0.95/META.yml 2007-02-03 09:19:25.000000000 +0100 +++ new/Net-Server-0.96/META.yml 2007-03-26 16:58:54.000000000 +0200 @@ -1,7 +1,7 @@ # http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Net-Server -version: 0.95 +version: 0.96 version_from: lib/Net/Server.pm installdirs: site requires: diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-Server-0.95/t/Options.t new/Net-Server-0.96/t/Options.t --- old/Net-Server-0.95/t/Options.t 2007-02-03 08:31:50.000000000 +0100 +++ new/Net-Server-0.96/t/Options.t 2007-02-05 16:27:39.000000000 +0100 @@ -10,7 +10,7 @@ use vars qw(@ISA); use strict; -use Test::More tests => 64; +use Test::More tests => 66; #use CGI::Ex::Dump qw(debug); use_ok('Net::Server'); @@ -191,27 +191,52 @@ $prop = eval { local @ARGV = ('--group=cmdline'); FooServer->run(conf_file => __FILE__.'.conf', group => 'runargs')->{'server'} }; ok($prop, "Loaded server"); $prop ||= {}; -ok($prop->{'group'} eq 'cmdline', "Right user \"$prop->{'group'}\""); +ok($prop->{'group'} eq 'cmdline', "Right group \"$prop->{'group'}\""); ###----------------------------------------------------------------### $prop = eval { FooServer->run(conf_file => __FILE__.'.conf', group => 'runargs')->{'server'} }; ok($prop, "Loaded server"); $prop ||= {}; -ok($prop->{'group'} eq 'runargs', "Right user \"$prop->{'group'}\""); +ok($prop->{'group'} eq 'runargs', "Right group \"$prop->{'group'}\""); ###----------------------------------------------------------------### $prop = eval { FooServer->run(conf_file => __FILE__.'.conf')->{'server'} }; ok($prop, "Loaded server"); $prop ||= {}; -ok($prop->{'group'} eq 'confgroup', "Right user \"$prop->{'group'}\""); +ok($prop->{'group'} eq 'confgroup', "Right group \"$prop->{'group'}\""); ###----------------------------------------------------------------### $prop = eval { FooServer->run->{'server'} }; ok($prop, "Loaded server"); $prop ||= {}; -ok($prop->{'group'} eq 'defaultgroup', "Right user \"$prop->{'group'}\""); +ok($prop->{'group'} eq 'defaultgroup', "Right group \"$prop->{'group'}\""); ok(@{ $prop->{'allow'} } == 2, "Defaults for allow are set also"); +###----------------------------------------------------------------### + +{ + package BarServer; + @BarServer::ISA = qw(FooServer); + sub default_values { + return { + conf_file => __FILE__.'.conf' + }; + } +} + +$prop = eval { BarServer->run->{'server'} }; +$prop ||= {}; +ok($prop->{'group'} eq 'confgroup', "Right group \"$prop->{'group'}\""); + +###----------------------------------------------------------------### + +$prop = eval { FooServer->new({ + conf_file => __FILE__.'.conf', # arguments passed to new win +})->run({ + conf_file => 'somefile_that_doesnot_exist', +})->{'server'} }; +$prop ||= {}; +ok($prop->{'group'} eq 'confgroup', "Right group \"$prop->{'group'}\""); ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Remember to have fun... --------------------------------------------------------------------- To unsubscribe, e-mail: opensuse-commit+unsubscribe@opensuse.org For additional commands, e-mail: opensuse-commit+help@opensuse.org