diff options
Diffstat (limited to 'gnu/usr.bin/perl/utils')
| -rw-r--r-- | gnu/usr.bin/perl/utils/c2ph.PL | 26 | ||||
| -rw-r--r-- | gnu/usr.bin/perl/utils/h2ph.PL | 93 | ||||
| -rw-r--r-- | gnu/usr.bin/perl/utils/h2xs.PL | 12 | ||||
| -rw-r--r-- | gnu/usr.bin/perl/utils/perlbug.PL | 22 |
4 files changed, 127 insertions, 26 deletions
diff --git a/gnu/usr.bin/perl/utils/c2ph.PL b/gnu/usr.bin/perl/utils/c2ph.PL index 91ecc04552b..9334aa10436 100644 --- a/gnu/usr.bin/perl/utils/c2ph.PL +++ b/gnu/usr.bin/perl/utils/c2ph.PL @@ -278,8 +278,9 @@ Anyway, here it is. Should run on perl v4 or greater. Maybe less. =cut -$RCSID = '$Id: c2ph,v 1.7 95/10/28 10:41:47 tchrist Exp Locker: tchrist $'; +$RCSID = '$Id: c2ph.PL,v 1.7 2003/12/03 03:02:50 millert Exp $'; +use File::Temp; ###################################################################### @@ -480,6 +481,13 @@ sub defvar { printf "%-16s%-15s %s\n", $var, eval "\$$var", $msg; } +sub safedir { + $SAFEDIR = File::Temp::tempdir("c2ph.XXXXXX", TMPDIR => 1, CLEANUP => 1) + unless (defined($SAFEDIR)); +} + +undef $SAFEDIR; + $recurse = 1; if (@ARGV) { @@ -495,15 +503,15 @@ if (@ARGV) { } elsif (@ARGV == 1 && $ARGV[0] =~ /\.c$/) { local($dir, $file) = $ARGV[0] =~ m#(.*/)?(.*)$#; - $chdir = "cd $dir; " if $dir; + $chdir = "cd $dir && " if $dir; &system("$chdir$CC $CFLAGS $DEFINES $file") && exit 1; $ARGV[0] =~ s/\.c$/.s/; } else { - $TMPDIR = tempdir(CLEANUP => 1); - $TMP = "$TMPDIR/c2ph.$$.c"; + &safedir; + $TMP = "$SAFEDIR/c2ph.$$.c"; &system("cat @ARGV > $TMP") && exit 1; - &system("cd $TMPDIR; $CC $CFLAGS $DEFINES $TMP") && exit 1; + &system("cd $SAFEDIR && $CC $CFLAGS $DEFINES $TMP") && exit 1; unlink $TMP; $TMP =~ s/\.c$/.s/; @ARGV = ($TMP); @@ -1274,8 +1282,8 @@ sub fetch_template { } sub compute_intrinsics { - $TMPDIR ||= tempdir(CLEANUP => 1); - local($TMP) = "$TMPDIR/c2ph-i.$$.c"; + &safedir; + local($TMP) = "$SAFEDIR/c2ph-i.$$.c"; open (TMP, ">$TMP") || die "can't open $TMP: $!"; select(TMP); @@ -1303,7 +1311,7 @@ EOF close TMP; select(STDOUT); - open(PIPE, "cd $TMPDIR && $CC $TMP && $TMPDIR/a.out|"); + open(PIPE, "cd $SAFEDIR && $CC $TMP && $SAFEDIR/a.out|"); while (<PIPE>) { chop; split(' ',$_,2);; @@ -1312,7 +1320,7 @@ EOF $intrinsics{$_[1]} = $template{$_[0]}; } close(PIPE) || die "couldn't read intrinsics!"; - unlink($TMP, '$TMPDIR/a.out'); + unlink($TMP, '$SAFEDIR/a.out'); print STDERR "done\n" if $trace; } diff --git a/gnu/usr.bin/perl/utils/h2ph.PL b/gnu/usr.bin/perl/utils/h2ph.PL index d28dc731f08..106336e4cab 100644 --- a/gnu/usr.bin/perl/utils/h2ph.PL +++ b/gnu/usr.bin/perl/utils/h2ph.PL @@ -58,13 +58,14 @@ my $Dest_dir = $opt_d || $Config{installsitearch}; die "Destination directory $Dest_dir doesn't exist or isn't a directory\n" unless -d $Dest_dir; -my @isatype = split(' ',<<END); +my @isatype = qw( char uchar u_char short ushort u_short int uint u_int long ulong u_long FILE key_t caddr_t -END + float double size_t +); my %isatype; @isatype{@isatype} = (1) x @isatype; @@ -133,9 +134,9 @@ while (defined (my $file = next_file())) { s/\(\w+\s*\(\*\)\s*\(\w*\)\)\s*(-?\d+)/$1/; # (int (*)(foo_t))0 if (s/^\(([\w,\s]*)\)//) { $args = $1; - my $proto = '() '; + my $proto = '() '; if ($args ne '') { - $proto = ''; + $proto = ''; foreach my $arg (split(/,\s*/,$args)) { $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/; $curargs{$arg} = 1; @@ -146,6 +147,7 @@ while (defined (my $file = next_file())) { s/^\s+//; expr(); $new =~ s/(["\\])/\\$1/g; #"]); + EMIT: $new = reindent($new); $args = reindent($args); if ($t ne '') { @@ -268,7 +270,7 @@ while (defined (my $file = next_file())) { } elsif(/^ident\s+(.*)/) { print OUT $t, "# $1\n"; } - } elsif(/^\s*(typedef\s*)?enum\s*(\s+[a-zA-Z_]\w*\s*)?/) { + } elsif (/^\s*(typedef\s*)?enum\s*(\s+[a-zA-Z_]\w*\s*)?/) { # { for vi until(/\{[^}]*\}.*;/ || /;/) { last unless defined ($next = next_line($file)); chomp $next; @@ -300,6 +302,75 @@ while (defined (my $file = next_file())) { "unless defined(\&$enum_name);\n"); } } + } elsif (/^(?:__extension__\s+)?(?:extern|static)\s+(?:__)?inline(?:__)?\s+/ + and !/;\s*$/ and !/{\s*}\s*$/) + { # { for vi + # This is a hack to parse the inline functions in the glibc headers. + # Warning: massive kludge ahead. We suppose inline functions + # are mainly constructed like macros. + while (1) { + last unless defined ($next = next_line($file)); + chomp $next; + undef $_, last if $next =~ /__THROW\s*;/ + or $next =~ /^(__extension__|extern|static)\b/; + $_ .= " $next"; + print OUT "# $next\n" if $opt_D; + last if $next =~ /^}|^{.*}\s*$/; + } + next if not defined; # because it's only a prototype + s/\b(__extension__|extern|static|(?:__)?inline(?:__)?)\b//g; + # violently drop #ifdefs + s/#\s*if.*?#\s*endif//g + and print OUT "# some #ifdef were dropped here -- fill in the blanks\n"; + if (s/^(?:\w|\s|\*)*\s(\w+)\s*//) { + $name = $1; + } else { + warn "name not found"; next; # shouldn't occur... + } + my @args; + if (s/^\(([^()]*)\)\s*(\w+\s*)*//) { + for my $arg (split /,/, $1) { + if ($arg =~ /(\w+)\s*$/) { + $curargs{$1} = 1; + push @args, $1; + } + } + } + $args = ( + @args + ? "local(" . (join ',', map "\$$_", @args) . ") = \@_;\n$t " + : "" + ); + my $proto = @args ? '' : '() '; + $new = ''; + s/\breturn\b//g; # "return" doesn't occur in macros usually... + expr(); + # try to find and perlify local C variables + our @local_variables = (); # needs to be a our(): (?{...}) bug workaround + { + use re "eval"; + my $typelist = join '|', keys %isatype; + $new =~ s[' + (?:(?:un)?signed\s+)? + (?:long\s+)? + (?:$typelist)\s+ + (\w+) + (?{ push @local_variables, $1 }) + '] + [my \$$1]gx; + $new =~ s[' + (?:(?:un)?signed\s+)? + (?:long\s+)? + (?:$typelist)\s+ + ' \s+ &(\w+) \s* ; + (?{ push @local_variables, $1 }) + ] + [my \$$1;]gx; + } + $new =~ s/&$_\b/\$$_/g for @local_variables; + $new =~ s/(["\\])/\\$1/g; #"]); + # now that's almost like a macro (we hope) + goto EMIT; } } $Is_converted{$file} = 1; @@ -308,7 +379,7 @@ while (defined (my $file = next_file())) { $next = ''; } else { print OUT "1;\n"; - queue_includes_from($file) if ($opt_a); + queue_includes_from($file) if $opt_a; } } @@ -380,10 +451,16 @@ sub expr { }; # Eliminate typedefs /\(([\w\s]+)[\*\s]*\)\s*[\w\(]/ && do { + my $doit = 1; foreach (split /\s+/, $1) { # Make sure all the words are types, - last unless ($isatype{$_} or $_ eq 'struct' or $_ eq 'union'); + unless($isatype{$_} or $_ eq 'struct' or $_ eq 'union'){ + $doit = 0; + last; + } + } + if( $doit ){ + s/\([\w\s]+[\*\s]*\)// && next; # then eliminate them. } - s/\([\w\s]+[\*\s]*\)// && next; # then eliminate them. }; # struct/union member, including arrays: s/^([_A-Z]\w*(\[[^\]]+\])?((\.|->)[_A-Z]\w*(\[[^\]]+\])?)+)//i && do { diff --git a/gnu/usr.bin/perl/utils/h2xs.PL b/gnu/usr.bin/perl/utils/h2xs.PL index ef2063d1cf3..18e73c2fffa 100644 --- a/gnu/usr.bin/perl/utils/h2xs.PL +++ b/gnu/usr.bin/perl/utils/h2xs.PL @@ -492,7 +492,7 @@ See L<perlxs> and L<perlxstut> for additional details. use strict; -my( $H2XS_VERSION ) = ' $Revision: 1.7 $ ' =~ /\$Revision:\s+([^\s]+)/; +my( $H2XS_VERSION ) = ' $Revision: 1.8 $ ' =~ /\$Revision:\s+([^\s]+)/; my $TEMPLATE_VERSION = '0.01'; my @ARGS = @ARGV; my $compat_version = $]; @@ -701,7 +701,8 @@ $opt_c = $opt_f = 1 if $opt_X; $opt_t ||= 'IV'; -my %const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s; +my %const_xsub; +%const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s; my $extralibs = ''; @@ -899,7 +900,7 @@ if( @path_h ){ next if $opt_e && $enum_name =~ /$opt_e/; my $val = 0; for my $item (split /,/, $enum_body) { - my ($key, $declared_val) = $item =~ /(\w*)\s*=\s*(.*)/; + my ($key, $declared_val) = $item =~ /(\w+)\s*=\s*(.*)/; $val = length($declared_val) ? $declared_val : 1 + $val; $seen_define{$key} = $declared_val; $const_names{$key}++; @@ -980,6 +981,8 @@ if( ! $opt_X ){ # use XS, unless it was disabled 'add_cppflags' => $addflags, 'c_styles' => \@styles; $c->set('includeDirs' => ["$Config::Config{archlib}/CORE", $cwd]); + $c->get('keywords')->{'__restrict'} = 1; + push @$fdecls_parsed, @{ $c->get('parsed_fdecls') }; push(@$fdecls, @{$c->get('fdecls')}); @@ -1307,7 +1310,8 @@ if ($opt_x && $opt_a) { my $licence_hash = $licence; $licence_hash =~ s/^/#/gm; -my $pod = <<"END" unless $opt_P; +my $pod; +$pod = <<"END" unless $opt_P; ## Below is stub documentation for your module. You'd better edit it! # #=head1 NAME diff --git a/gnu/usr.bin/perl/utils/perlbug.PL b/gnu/usr.bin/perl/utils/perlbug.PL index b9906f8acfe..8f3e6a0d2c1 100644 --- a/gnu/usr.bin/perl/utils/perlbug.PL +++ b/gnu/usr.bin/perl/utils/perlbug.PL @@ -89,9 +89,12 @@ BEGIN { $::HaveSend = ($@ eq ""); eval "use Mail::Util;"; $::HaveUtil = ($@ eq ""); + # use secure tempfiles wherever possible + eval "require File::Temp;"; + $::HaveTemp = ($@ eq ""); }; -my $Version = "1.34"; +my $Version = "1.35"; # Changed in 1.06 to skip Mail::Send and Mail::Util if not available. # Changed in 1.07 to see more sendmail execs, and added pipe output. @@ -130,6 +133,7 @@ my $Version = "1.34"; # Changed in 1.32 Use File::Spec->tmpdir TJENNESS 20-08-2000 # Changed in 1.33 Don't require -t STDOUT for -ok. # Changed in 1.34 Added Message-Id RFOLEY 18-06-2002 +# Changed in 1.35 Use File::Temp (patch from Solar Designer) NWCLARK 28-02-2004 # TODO: - Allow the user to re-name the file on mail failure, and # make sure failure (transmission-wise) of Mail::Send is @@ -958,10 +962,18 @@ EOF } sub filename { - my $dir = File::Spec->tmpdir(); - $filename = "bugrep0$$"; - $filename++ while -e File::Spec->catfile($dir, $filename); - $filename = File::Spec->catfile($dir, $filename); + if ($::HaveTemp) { + # Good. Use a secure temp file + my ($fh, $filename) = File::Temp::tempfile(UNLINK => 1); + close($fh); + return $filename; + } else { + # Bah. Fall back to doing things less securely. + my $dir = File::Spec->tmpdir(); + $filename = "bugrep0$$"; + $filename++ while -e File::Spec->catfile($dir, $filename); + $filename = File::Spec->catfile($dir, $filename); + } } sub paraprint { |