diff options
| -rw-r--r-- | Porting/makerel | 17 | ||||
| -rw-r--r-- | ext/re/re.pm | 2 | ||||
| -rw-r--r-- | lib/Sys/Syslog.pm | 51 |
3 files changed, 47 insertions, 23 deletions
diff --git a/Porting/makerel b/Porting/makerel index 809de9bbec..1a00e973a3 100644 --- a/Porting/makerel +++ b/Porting/makerel @@ -17,7 +17,10 @@ $relroot = ".."; # XXX make an option die "Must be in root of the perl source tree.\n" unless -f "./MANIFEST" and -f "patchlevel.h"; -$patchlevel_h = `grep '#define ' patchlevel.h`; +open PATCHLEVEL,"<patchlevel.h" or die; +my @patchlevel_h = <PATCHLEVEL>; +close PATCHLEVEL; +my $patchlevel_h = join "", grep { /^#define/ } @patchlevel_h; print $patchlevel_h; $patchlevel = $1 if $patchlevel_h =~ /PATCHLEVEL\s+(\d+)/; $subversion = $1 if $patchlevel_h =~ /SUBVERSION\s+(\d+)/; @@ -31,13 +34,19 @@ if ($subversion) { $vms_vers.= " "; } +# fetch list of local patches +my (@local_patches, @lpatch_tags, $lpatch_tags); +@local_patches = grep { /^static.*local_patches/../^};/ } @patchlevel_h; +@local_patches = grep { !/^\s*,?NULL/ } @local_patches; +@lpatch_tags = map { /^\s*,"(\w+)/ } @local_patches; +$lpatch_tags = join "-", @lpatch_tags; + $perl = "perl$vers"; $reldir = "$perl"; -$reldir .= "-$ARGV[0]" if $ARGV[0]; +$reldir .= "-$lpatch_tags" if $lpatch_tags; print "\nMaking a release for $perl in $relroot/$reldir\n\n"; - print "Cross-checking the MANIFEST...\n"; ($missfile, $missentry) = fullcheck(); warn "Can't make a release with MANIFEST files missing.\n" if @$missfile; @@ -101,7 +110,7 @@ chdir $relroot or die $!; print "Creating and compressing the tar file...\n"; my $src = (-e $perl) ? $perl : 'perl'; # 'perl' in maint branch -$cmd = "tar cf - $reldir | gzip --best > $perl.tar.gz"; +$cmd = "tar cf - $reldir | gzip --best > $reldir.tar.gz"; system($cmd) == 0 or die "$cmd failed"; print "\n"; diff --git a/ext/re/re.pm b/ext/re/re.pm index a033d97c94..5ec012dee6 100644 --- a/ext/re/re.pm +++ b/ext/re/re.pm @@ -27,6 +27,8 @@ re - Perl pragma to alter regular expression behaviour /^(.*)$/s; # output debugging info # during compile and run time +(We use $^X in these examples because it's tainted by default.) + =head1 DESCRIPTION When C<use re 'taint'> is in effect, and a tainted string is the target diff --git a/lib/Sys/Syslog.pm b/lib/Sys/Syslog.pm index 709f5785f5..1f92e60ccf 100644 --- a/lib/Sys/Syslog.pm +++ b/lib/Sys/Syslog.pm @@ -5,6 +5,7 @@ use Carp; @ISA = qw(Exporter); @EXPORT = qw(openlog closelog setlogmask syslog); +@EXPORT_OK = qw(setlogsock); use Socket; use Sys::Hostname; @@ -14,6 +15,10 @@ use Sys::Hostname; # Tom Christiansen <tchrist@convex.com> # modified to use sockets by Larry Wall <lwall@jpl-devvax.jpl.nasa.gov> # NOTE: openlog now takes three arguments, just like openlog(3) +# Modified to add UNIX domain sockets by Sean Robinson <robinson_s@sc.maricopa.edu> +# with support from Tim Bunce <Tim.Bunce@ig.co.uk> and the perl5-porters mailing list + +# Todo: enable connect to try all three types before failing (auto setlogsock)? =head1 NAME @@ -21,8 +26,10 @@ Sys::Syslog, openlog, closelog, setlogmask, syslog - Perl interface to the UNIX =head1 SYNOPSIS - use Sys::Syslog; + use Sys::Syslog; # all except setlogsock, or: + use Sys::Syslog qw(:DEFAULT setlogsock); # default set, plus setlogsock + setlogsock $sock_type; openlog $ident, $logopt, $facility; syslog $priority, $format, @args; $oldmask = setlogmask $mask_priority; @@ -54,20 +61,18 @@ is replaced with C<"$!"> (the latest error message). Sets log mask I<$mask_priority> and returns the old mask. -=item setlogsock $sock_type (added in 5.004_03) - +=item setlogsock $sock_type (added in 5.004_02) + Sets the socket type to be used for the next call to -C<openlog()> or C<syslog()>. - +C<openlog()> or C<syslog()> and returns TRUE on success, +undef on failure. + A value of 'unix' will connect to the UNIX domain socket returned by -C<_PATH_LOG> in F<syslog.ph>. If F<syslog.ph> fails to define -C<_PATH_LOG>, C<setlogsock> returns C<undef>; otherwise a true value is -returned. A value of 'inet' will connect to an INET socket returned by -getservbyname(). Any other value croaks. +C<_PATH_LOG> in F<syslog.ph>. A value of 'inet' will connect to an +INET socket returned by getservbyname(). Any other value croaks. The default is for the INET socket to be used. - =item closelog Closes the log file. @@ -135,14 +140,19 @@ sub setlogmask { sub setlogsock { local($setsock) = shift; + &disconnect if $connected; if (lc($setsock) eq 'unix') { - if (defined &_PATH_LOG) { - $sock_unix = 1; - } else { - return undef; - } + if (defined &_PATH_LOG) { + $sock_type = 1; + } else { + return undef; + } } elsif (lc($setsock) eq 'inet') { - undef($sock_unix); + if (getservbyname('syslog','udp')) { + undef($sock_type); + } else { + return undef; + } } else { croak "Invalid argument passed to setlogsock; must be 'unix' or 'inet'"; } @@ -238,7 +248,7 @@ sub connect { my($host_uniq) = Sys::Hostname::hostname(); ($host) = $host_uniq =~ /([A-Za-z0-9_.-]+)/; # allow FQDN (inc _) } - unless ( $sock_unix ) { + unless ( $sock_type ) { my $udp = getprotobyname('udp'); my $syslog = getservbyname('syslog','udp'); my $this = sockaddr_in($syslog, INADDR_ANY); @@ -248,8 +258,11 @@ sub connect { } else { my $syslog = &_PATH_LOG || croak "_PATH_LOG not found in syslog.ph"; my $that = sockaddr_un($syslog) || croak "Can't locate $syslog"; - socket(SYSLOG,AF_UNIX,SOCK_STREAM,0) || croak "open: $!"; - connect(SYSLOG,$that) || croak "connect: $!"; + socket(SYSLOG,AF_UNIX,SOCK_STREAM,0) || croak "socket: $!"; + if (!connect(SYSLOG,$that)) { + socket(SYSLOG,AF_UNIX,SOCK_DGRAM,0) || croak "socket: $!"; + connect(SYSLOG,$that) || croak "connect: $! (SOCK_DGRAM after trying SOCK_STREAM)"; + } } local($old) = select(SYSLOG); $| = 1; select($old); $connected = 1; |