Hello community,
here is the log from the commit of package perl-Net-Server
checked in at Mon Oct 8 12:28:09 CEST 2007.
--------
--- perl-Net-Server/perl-Net-Server.changes 2007-03-30 16:12:48.000000000 +0200
+++ /mounts/work_src_done/STABLE/perl-Net-Server/perl-Net-Server.changes 2007-10-08 09:55:35.000000000 +0200
@@ -1,0 +2,9 @@
+Mon Oct 8 09:28:02 CEST 2007 - anicka@suse.cz
+
+- update to 0.97
+ * Allow for better handling of setlogsock depending upon
+ the version of Sys::Syslog installed
+ * Update examples with minimal pod and working synopses
+ * Added post_client_connection_hook
+
+-------------------------------------------------------------------
Old:
----
Net-Server-0.96.tar.bz2
New:
----
Net-Server-0.97.tar.bz2
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-Net-Server.spec ++++++
--- /var/tmp/diff_new_pack.M12587/_old 2007-10-08 12:28:01.000000000 +0200
+++ /var/tmp/diff_new_pack.M12587/_new 2007-10-08 12:28:02.000000000 +0200
@@ -1,5 +1,5 @@
#
-# spec file for package perl-Net-Server (Version 0.96)
+# spec file for package perl-Net-Server (Version 0.97)
#
# Copyright (c) 2007 SUSE LINUX Products GmbH, Nuernberg, Germany.
# This file and all modifications and additions to the pristine
@@ -11,13 +11,13 @@
# norootforbuild
Name: perl-Net-Server
-URL: http://cpan.org/modules/by-module/Net/
-License: Artistic License, GNU General Public License (GPL)
+Url: http://cpan.org/modules/by-module/Net/
+License: Artistic License; GPL v2 or later
Group: Development/Libraries/Perl
Requires: perl = %{perl_version}
-Autoreqprov: on
+AutoReqProv: on
Summary: Net::Server - Extensible, general Perl server engine
-Version: 0.96
+Version: 0.97
Release: 1
Source: Net-Server-%{version}.tar.bz2
Requires: perl-IO-Multiplex
@@ -61,8 +61,13 @@
%dir %{perl_vendorarch}/auto/Net
%{perl_vendorarch}/auto/Net/Server
/var/adm/perl-modules/perl-Net-Server
-
%changelog
+* Mon Oct 08 2007 - anicka@suse.cz
+- update to 0.97
+ * Allow for better handling of setlogsock depending upon
+ the version of Sys::Syslog installed
+ * Update examples with minimal pod and working synopses
+ * Added post_client_connection_hook
* Fri Mar 30 2007 - anicka@suse.cz
- update to 0.96
* Allow for conf_file to be specified in the default_values.
++++++ Net-Server-0.96.tar.bz2 -> Net-Server-0.97.tar.bz2 ++++++
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-Server-0.96/Changes new/Net-Server-0.97/Changes
--- old/Net-Server-0.96/Changes 2007-03-23 23:22:29.000000000 +0100
+++ new/Net-Server-0.97/Changes 2007-07-25 18:17:20.000000000 +0200
@@ -1,5 +1,10 @@
Revision history for Perl extension Net::Server.
+0.97 Jul 25 2007
+ - Allow for better handling of setlogsock depending upon the version of Sys::Syslog installed (David Schweikert)
+ - Update examples with minimal pod and working synopses
+ - Added post_client_connection_hook (Mihail Nasedkin)
+
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.
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-Server-0.96/examples/connection_test.pl new/Net-Server-0.97/examples/connection_test.pl
--- old/Net-Server-0.96/examples/connection_test.pl 2001-08-16 01:25:54.000000000 +0200
+++ new/Net-Server-0.97/examples/connection_test.pl 2007-07-25 17:38:55.000000000 +0200
@@ -1,10 +1,38 @@
#!/usr/bin/perl -w
+=head1 NAME
+
+connection_test.pl - Test UDP/TCP/UNIX/UNIX_DGRAM connections
+
+=head1 SERVER SYNOPSIS
+
+ # in a separate terminal window
+
+ perl connection_test.pl
+
+=head1 CLIENT SYNOPSIS
+
+ perl connection_test.pl UDP
+
+ # or
+
+ perl connection_test.pl TCP
+
+ # or
+
+ perl connection_test.pl UNIX
+
+ # or
+
+ perl connection_test.pl UNIX_DGRAM
+
+=cut
+
package MyPack;
use strict;
-use vars qw(@ISA);
-use Net::Server ();
+use warnings;
+use base qw(Net::Server);
use IO::Socket ();
use POSIX qw(tmpnam);
use Socket qw(SOCK_DGRAM SOCK_STREAM);
@@ -23,10 +51,10 @@
my $tcp_port = 20204;
print "\$Net::Server::VERSION = $Net::Server::VERSION\n";
-@ISA = qw(Net::Server);
if( @ARGV ){
if( uc($ARGV[0]) eq 'UDP' ){
+ print "Testing UDP\n";
my $sock = IO::Socket::INET->new(PeerAddr => 'localhost',
PeerPort => $udp_port,
Proto => 'udp',
@@ -34,12 +62,13 @@
### send a packet, get a packet
$sock->send("Are you there?",0);
my $data = undef;
- $sock->recv($data,4096,0);
+ $sock->recv($data,4096,0);
print $data,"\n";
exit;
}
if( uc($ARGV[0]) eq 'TCP' ){
+ print "Testing TCP\n";
my $sock = IO::Socket::INET->new(PeerAddr => 'localhost',
PeerPort => $tcp_port,
Proto => 'tcp',
@@ -51,6 +80,7 @@
}
if( uc($ARGV[0]) eq 'UNIX' ){
+ print "Testing UNIX (File socket with SOCK_STREAM)\n";
my $sock = IO::Socket::UNIX->new(Peer => $socket_file) || die "Can't connect [$!]";
print $sock "hi\n";
@@ -60,6 +90,7 @@
}
if( uc($ARGV[0]) eq 'UNIX_DGRAM' ){
+ print "Testing UNIX_DGRAM\n";
my $sock = IO::Socket::UNIX->new(Peer => $socket_file2,
Type => SOCK_DGRAM,
) || die "Can't connect [$!]";
@@ -70,7 +101,7 @@
### however, the default arguments don't seem to work for
### sending it back. If anybody knows why, let me know.
my $data = undef;
- $sock->recv($data,4096,0);
+ $sock->recv($data,4096,0);
print $data,"\n";
exit;
}
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-Server-0.96/examples/httpd new/Net-Server-0.97/examples/httpd
--- old/Net-Server-0.96/examples/httpd 2005-06-21 05:51:51.000000000 +0200
+++ new/Net-Server-0.97/examples/httpd 2007-07-25 17:32:03.000000000 +0200
@@ -1,4 +1,16 @@
-#!/usr/bin/perl -w -T
+#!/usr/bin/perl
+
+=head1 NAME
+
+httpd - Simple http daemon
+
+=head1 SYNOPSIS
+
+ # customize options in sub configure_hook
+
+ ./httpd
+
+=cut
###----------------------------------------###
### httpd server class ###
@@ -6,6 +18,7 @@
use base qw(Net::Server::PreFork);
use strict;
+use warnings;
### run the server
__PACKAGE__->run;
@@ -17,7 +30,7 @@
sub configure_hook {
my $self = shift;
- my $root = $self->{server_root} = "/home/http";
+ my $root = $self->{server_root} = "/var/www";
$self->{server}->{port} = '*:80'; # port and addr to bind
$self->{server}->{user} = 'nobody'; # user to run as
@@ -26,7 +39,7 @@
$self->{server}->{log_file} = "$root/server.log";
- $self->{document_root} = "$root/www";
+ $self->{document_root} = "$root/htdocs";
$self->{access_log} = "$root/access.log";
$self->{error_log} = "$root/error.log";
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-Server-0.96/examples/LoadTester.pl new/Net-Server-0.97/examples/LoadTester.pl
--- old/Net-Server-0.96/examples/LoadTester.pl 2005-12-03 17:18:51.000000000 +0100
+++ new/Net-Server-0.97/examples/LoadTester.pl 2007-07-25 17:26:05.000000000 +0200
@@ -1,28 +1,50 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
-#use Time::HiRes qw(time); # uncomment for more accuracy
-use vars qw(@ISA);
+=head1 NAME
+
+LoadTester.pl - Allow for testing load agains various servers
+
+=head1 SYNOPIS
+
+ # start - or find a server somewhere
+
+ perl -e 'use base qw(Net::Server::PreForkSimple); __PACKAGE__->run'
+
+
+ # change parameters in sub configure_hook
+ # setup the load to test against the server in sub load
+
+ # run this script
+
+ LoadTester.pl
+
+=cut
+
+BEGIN {
+ Time::HiRes->import('time') if eval { require Time::HiRes };
+}
use strict;
-use Net::Server::PreFork;
+use warnings;
+use base qw(Net::Server::PreFork);
use IO::Socket;
-@ISA = qw(Net::Server::PreFork);
-main->run();
+$| = 1;
+__PACKAGE__->run(min_servers => 100, max_servers => 255);
exit;
-$|=1;
+###----------------------------------------------------------------###
### set up the test parameters
sub configure_hook {
- my $self = shift;
- $self->{addr} = 'localhost'; # choose a remote addr
- $self->{port} = 20203; # choose a remote port
- $self->{file} = '/tmp/mysock'; # sock file for Load testing a unix socket
- $self->{failed} = 0; # failed hits (server was blocked)
- $self->{hits} = 0; # log hits
- $self->{max_hits} = 1000; # how many impressions to do
- $self->{time_begin} = time; # keep track of time
- $self->{sleep} = 0; # sleep between hits?
+ my $self = shift;
+ $self->{addr} = 'localhost'; # choose a remote addr
+ $self->{port} = 20203; # choose a remote port
+ $self->{file} = '/tmp/mysock'; # sock file for Load testing a unix socket
+ $self->{failed} = 0; # failed hits (server was blocked)
+ $self->{hits} = 0; # log hits
+ $self->{max_hits} = 1000; # how many impressions to do
+ $self->{time_begin} = time; # keep track of time
+ $self->{sleep} = 0; # sleep between hits?
}
@@ -70,7 +92,7 @@
my $line = <$handle>;
print $handle "quit\n";
}
-
+
### keep track of what is going on
sub parent_read_hook {
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-Server-0.96/examples/samplechat.pl new/Net-Server-0.97/examples/samplechat.pl
--- old/Net-Server-0.96/examples/samplechat.pl 2001-10-23 21:15:29.000000000 +0200
+++ new/Net-Server-0.97/examples/samplechat.pl 2007-07-25 17:01:44.000000000 +0200
@@ -1,24 +1,42 @@
-#!/usr/bin/perl -w -T
+#!/usr/bin/perl -w
-# This example demonstrates some of the features of Net::Server::Multiplex
-#
-#
-# To run this in background daemon mode, listening on port 2000, do:
-#
-# samplechat.pl --setsid=1 --log_file=/tmp/samplechat.log --pid_file=/tmp/samplechat.pid --port=2000
-#
-# To turn off the daemon, do:
-#
-# kill `cat /tmp/samplechat.pid`;
-#
+=head1 NAME
+
+samplechat.pl - Show a basic Net::Server::Multiplex sample
+
+=head SERVER SYNOPIS
+
+ # To run this in background daemon mode, listening on port 2000, do:
+
+ samplechat.pl --setsid=1 --log_file=/tmp/samplechat.log --pid_file=/tmp/samplechat.pid --port=2000
+
+ # To turn off the daemon, do:
+
+ kill `cat /tmp/samplechat.pid`;
+
+=head CLIENT SYNOPIS
+
+ # from a terminal type
+
+ telnet localhost 2000
+
+ # you will then be in a echo server.
+
+=head DESCRIPTION
+
+This example demonstrates some of the features of Net::Server::Multiplex
+
+=cut
package SampleChatServer;
use strict;
-use Net::Server::Multiplex;
-use vars qw(@ISA);
-@ISA = qw(Net::Server::Multiplex);
+use base qw(Net::Server::Multiplex);
+__PACKAGE__->run();
+exit;
+
+###----------------------------------------------------------------###
# Demonstrate a Net::Server style hook
sub allow_deny_hook {
@@ -138,6 +156,3 @@
print $fh $msg;
}
}
-
-
-__PACKAGE__->run();
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-Server-0.96/examples/sigtest.pl new/Net-Server-0.97/examples/sigtest.pl
--- old/Net-Server-0.96/examples/sigtest.pl 2001-08-22 00:13:48.000000000 +0200
+++ new/Net-Server-0.97/examples/sigtest.pl 2007-07-25 16:58:14.000000000 +0200
@@ -1,5 +1,29 @@
#!/usr/bin/perl -w
+=head1 NAME
+
+sigtest.pl - test for safe/unsafe signal handling
+
+=head1 SYNOPSIS
+
+ sigtest.pl SIGNAME SAFE|UNSAFE
+
+ # (SIGNAME is a standard signal - default is USR1)
+ # (SAFE will use Net::Server::SIG, UNSAFE uses \$SIG{} - default is SAFE)
+ # If the child isn't saying anything, the test is invalid.
+ # If the child dies, look for a core file.
+
+ # The process will run until it dies or you kill it
+
+=head1 DESCRIPTION
+
+Recent versions of Perl (5.8 ish) have much better signal handling
+so the safe signal handling may not be necessary. But on older versions
+of Perl the safe signal handling was necessary. It still doesn't hurt to
+use some of the safer practices on newer Perls.
+
+=cut
+
use IO::Select ();
use IO::Socket ();
use Net::Server::SIG qw(register_sig check_sigs);
@@ -104,7 +128,7 @@
my $val;
### this is the handler for safe (fine under unsafe also)
- next if &check_sigs() && ! @fh;
+ next if check_sigs() && ! @fh;
### do some hash manipulation
delete $hash{foo};
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-Server-0.96/examples/udp_server.pl new/Net-Server-0.97/examples/udp_server.pl
--- old/Net-Server-0.96/examples/udp_server.pl 2001-08-08 07:00:45.000000000 +0200
+++ new/Net-Server-0.97/examples/udp_server.pl 2007-07-25 16:48:35.000000000 +0200
@@ -1,65 +1,117 @@
-#!/usr/bin/perl -w -T
+#!/usr/bin/perl
+
+=head1 NAME
+
+udp_server.pl - Simple sample udp echo server
+
+=head1 SERVER SYNOPSIS
+
+ perl udp_server.pl --log_level 3
+ # default is to not background
+
+=head1 CLIENT SYNOPSIS
+
+ # In another terminal
+
+ perl udp_server.pl --client
+
+=cut
-###----------------------------------------###
-### sample udp server class ###
-###----------------------------------------###
package MyUDPD;
-use lib qw(/home/rhandom/Net-Server/lib);
-use vars qw(@ISA);
use strict;
+use warnings;
+use Data::Dumper;
+
+my $port = 20203;
+my $host = 'localhost';
+my $recv_length = 8192; # packet size
### what type of server is this - we could
### use multi type when we add command line
### parsing to this http server to allow
### for different configurations
-use Net::Server::PreFork;
-@ISA = qw(Net::Server::PreFork);
+use base qw(Net::Server::PreFork);
-### run the server
-MyUDPD->run( port => '20203/udp',
- # we could also do the following:
- # port => '*:20203/udp',
- # port => 'somehost:20203/udp',
- # port => '20203/udp', port => '20204/udp',
- # port => '20203/udp', port => '20203/tcp',
- );
-exit;
+if (grep {/\bclient\b/i} @ARGV) {
+ handle_client();
+} else {
+ ### run the server
+ MyUDPD->run( port => "$host:$port/udp",
+ # we could also do the following:
+ # port => '*:20203/udp',
+ # port => 'somehost:20203/udp',
+ # port => '20203/udp', port => '20204/udp',
+ # port => '20203/udp', port => '20203/tcp',
+ );
+}
+exit;
+###----------------------------------------------------------------###
+### overridden server hooks
### set up some server parameters
sub configure_hook {
my $self = shift;
### change the packet len?
- # $self->{server}->{udp_recv_len} ||= 2048; # default is 4096
+ $self->{server}->{udp_recv_len} = $recv_length; # default is 4096
}
-
-
### this is the main method to override
### this is where most of the work will occur
### A sample server is shown below.
sub process_request {
my $self = shift;
- my $prop = $self->{server};
+ my $prop = $self->{'server'};
### if we were writing a server that did both tcp and udp,
### we would need to check $prop->{udp_true} to see
### if the current connection is udp or not
-
-# if( $prop->{udp_true} ){
-# # yup, this is udp
-# }
-
- if( $prop->{udp_data} =~ /dump/ ){
- require "Data/Dumper.pm";
- $prop->{client}->send( Data::Dumper::Dumper( $self ) , 0);
- }else{
- $prop->{client}->send( "You said \"$prop->{udp_data}\"", 0);
+ # if ($prop->{udp_true}) {
+ # # yup, this is udp
+ # }
+
+ # all of the client data is already in 'udp_data'
+ if ($prop->{'udp_data'} =~ /dump/) {
+ local $Data::Dumper::Sortkeys = 1;
+ $prop->{'client'}->send(Data::Dumper::Dumper($self), 0);
+ } else {
+ $prop->{'client'}->send("You said \"$prop->{udp_data}\"", 0);
}
return;
}
+
+
+###----------------------------------------------------------------###
+### dummy client terminal echo relay
+
+sub handle_client {
+ require IO::Socket;
+
+ my $recv_flags = 0;
+
+ print "$0\nEcho server client relay\nType anything and hit enter\n";
+ print "-------------------------------\n";
+ while (defined(my $line = <STDIN>)) {
+ chomp $line;
+
+ my $sock = IO::Socket::INET->new(
+ PeerAddr => $host,
+ PeerPort => $port,
+ Proto => 'udp',
+ )
+ || die "Couldn't connect to $host:$port: $!";
+
+ $sock->send($line, 0);
+
+ my $data = '';
+ $sock->recv($data, $recv_length, $recv_flags);
+
+ print "From the server:\n$data\n-------------------------\n";
+ }
+
+}
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-Server-0.96/lib/Net/Server.pm new/Net-Server-0.97/lib/Net/Server.pm
--- old/Net-Server-0.96/lib/Net/Server.pm 2007-03-23 19:39:48.000000000 +0100
+++ new/Net-Server-0.97/lib/Net/Server.pm 2007-07-25 18:21:14.000000000 +0200
@@ -2,7 +2,7 @@
#
# Net::Server - Extensible Perl internet server
#
-# $Id: Server.pm,v 1.112 2007/03/23 18:39:48 rhandom Exp $
+# $Id: Server.pm,v 1.114 2007/07/25 16:21:14 rhandom Exp $
#
# Copyright (C) 2001-2007
#
@@ -37,7 +37,7 @@
safe_fork
);
-$VERSION = '0.96';
+$VERSION = '0.97';
###----------------------------------------------------------------###
@@ -154,6 +154,7 @@
$self->post_process_request; # clean up client connection, etc
+ $self->post_client_connection_hook; # one last hook
}
###----------------------------------------------------------------###
@@ -909,6 +910,7 @@
### user customizable hook
sub post_process_request_hook {}
+sub post_client_connection_hook {}
### this is server type specific functions after the process
sub post_process_request {
@@ -1196,17 +1198,26 @@
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';
+ require Sys::Syslog;
+
+ if (ref($prop->{syslog_logsock}) eq 'ARRAY') {
+ # do nothing - assume they have what they want
+ } else {
+ if (! defined $prop->{syslog_logsock}) {
+ $prop->{syslog_logsock} = ($Sys::Syslog::VERSION < 0.15) ? 'unix' : '';
+ }
+ if ($prop->{syslog_logsock} =~ /^(|native|tcp|udp|unix|inet|stream|console)$/) {
+ $prop->{syslog_logsock} = $1;
+ } else {
+ $prop->{syslog_logsock} = ($Sys::Syslog::VERSION < 0.15) ? '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';
@@ -1218,7 +1229,9 @@
$prop->{syslog_facility} = ($fac =~ /^((\w+)($|\|))*/)
? $1 : 'daemon';
- Sys::Syslog::setlogsock($prop->{syslog_logsock}) || die "Syslog err [$!]";
+ if ($prop->{syslog_logsock}) {
+ Sys::Syslog::setlogsock($prop->{syslog_logsock}) || die "Syslog err [$!]";
+ }
if( ! Sys::Syslog::openlog($prop->{syslog_ident},
$prop->{syslog_logopt},
$prop->{syslog_facility}) ){
diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/Net-Server-0.96/lib/Net/Server.pod new/Net-Server-0.97/lib/Net/Server.pod
--- old/Net-Server-0.96/lib/Net/Server.pod 2007-03-23 23:24:33.000000000 +0100
+++ new/Net-Server-0.97/lib/Net/Server.pod 2007-07-25 18:19:40.000000000 +0200
@@ -414,7 +414,8 @@
log_file (filename|Sys::Syslog) undef
## syslog parameters
- syslog_logsock (unix|inet) unix
+ syslog_logsock (native|unix|inet|udp
+ |tcp|stream|console) unix (on Sys::Syslog < 0.15)
syslog_ident "identity" "net_server"
syslog_logopt (cons|ndelay|nowait|pid) pid
syslog_facility \w+ daemon
@@ -514,7 +515,11 @@
=item syslog_logsock
Only available if C