echo "print 'Hello, world'" | perl - ***** #!/bin/sh -- # -*- perl -*- -p eval 'exec perl $0 -S ${1+"$@"}' if 0; ***** #!/bin/sh echo "I am a shell script" ***** #!/usr/bin/perl -spi.bak # same as -s -p -i.bak ***** find . -name '*.bak' -print0 | perl -n0e unlink ***** perl -ane 'print pop(@F), "\n";' ***** while (<>) { @F = split(' '); print pop(@F), "\n"; } ***** $ perl -p -i.bak -e "s/foo/bar/; ... " ***** #!/usr/bin/perl -pi.bak s/foo/bar/; ***** #!/usr/bin/perl while (<>) { if ($ARGV ne $oldargv) { rename($ARGV, $ARGV . '.bak'); open(ARGVOUT, ">$ARGV"); select(ARGVOUT); $oldargv = $ARGV; } s/foo/bar/; } continue { print; # this prints to original filename } select(STDOUT); ***** perl -lpe 'substr($_, 80) = ""' ***** gnufind / -print0 | perl -ln0e 'print "found $_" if -p' ***** use module split(/,/, q{foo, bar}) ***** LINE: while (<>) { ... # your script goes here } ***** find . -mtime +7 -print | perl -nle 'unlink;' ***** LINE: while (<>) { ... # your script goes here } continue { print; } ***** #!/usr/bin/perl -s if ($xyz) { print "true\n"; } ***** #!/usr/bin/perl -s if ($xyz eq 'abc') { print "true\n"; } ***** #!/usr/bin/perl eval "exec /usr/bin/perl -S $0 $*" if $running_under_some_shell; ***** eval '(exit $?0)' && eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' & eval 'exec /usr/bin/perl -S $0 $argv:q' if 0; ***** sub catch_zap { my $signame = shift; $shucks++; die "Somebody sent me a SIG$signame!"; } $SIG{INT} = 'catch_zap'; # could fail outside of package main $SIG{INT} = \&catch_zap; # best strategy ***** use Config; defined $Config{sig_name} or die "No sigs?"; $i = 0; # Config prepends fake 0 signal called "ZERO". foreach $name (split(' ', $Config{sig_name})) { $signo{$name} = $i; $signame[$i] = $name; $i++; } ***** print "signal #17 = $signame[17]\n"; if ($signo{ALRM}) { print "SIGALRM is $signo{ALRM}\n"; } ***** sub precious { local $SIG{INT} = 'IGNORE'; &more_functions; } sub more_functions { # interrupts still ignored, for now... } ***** { local $SIG{HUP} = 'IGNORE'; kill HUP => -$$; # snazzy form of: kill('HUP', -$$) } ***** unless (kill 0 => $kid_pid) { warn "something wicked happened to $kid_pid"; } ***** $SIG{INT} = sub { die "\nOutta here!\n" }; ***** sub REAPER { $SIG{CHLD} = \&REAPER; # loathe sysV $waitedpid = wait; } $SIG{CHLD} = \&REAPER; # now do something that forks... ***** use POSIX "wait_h"; sub REAPER { $SIG{CHLD} = \&REAPER; # loathe sysV, dream of real POSIX my $child; while ($child = waitpid(-1, WNOHANG)) { $Kid_Status{$child} = $?; } } $SIG{CHLD} = \&REAPER; # do something that forks... ***** use Config; print "Hurray!\n" if $Config{d_sigaction}; ***** egrep 'S[AV]_(RESTART|INTERRUPT)' /usr/include/*/signal.h ***** eval { local $SIG{ALRM} = sub { die "alarm clock restart" }; alarm 10; # schedule alarm in 10 seconds flock(FH, 2); # a "write" lock that may block alarm 0; # cancel the alarm }; if ($@ and $@ !~ /alarm clock restart/) { die } ***** open SPOOLER, "| cat -v | lpr -h 2>/dev/null" or die "can't fork: $!"; local $SIG{PIPE} = sub { die "spooler pipe broke" }; print SPOOLER "stuff\n"; close SPOOLER or die "bad spool: $! $?"; ***** open STATUS, "netstat -an 2>&1 |" or die "can't fork: $!"; while () { next if /^(tcp|udp)/; print; } close SPOOLER or die "bad netstat: $! $?"; ***** print grep { !/^(tcp|udp)/ } `netstat -an 2>&1`; die "bad netstat" if $?; ***** open(PROG_FOR_READING_AND_WRITING, "| some program |") # WRONG! ***** Can't do bidirectional pipe at myprog line 3. ***** use FileHandle; use IPC::Open2; $pid = open2( \*Reader, \*Writer, "cat -u -n" ); Writer->autoflush(); # This is default, actually. print Writer "stuff\n"; $got = ; ***** require 'Comm.pl'; $ph = open_proc('cat -n'); for (1..10) { print $ph "a line\n"; print "got back ", scalar <$ph>; } ***** #!/usr/bin/perl -w require 5.003; use strict; use sigtrap; use Socket; ***** for ( $waitedpid = 0; ($paddr = accept(Client,Server)) || $waitedpid; $waitedpid = 0, close Client) { next if $waitedpid; # alternately, check for $! == EINTR # the rest is the same... ***** unless ( -S '/dev/log' ) { die "something's wicked with the print system"; } ***** $arg = shift; # $arg is tainted $hid = $arg, 'bar'; # $hid is also tainted $line = <>; # Tainted $path = $ENV{PATH}; # Tainted, but see below $mine = 'abc'; # Not tainted $shout = `echo abc`; # Tainted $shout = `echo $shout`; # Insecure system "echo $arg"; # Insecure (uses sh) system "/bin/echo", $arg; # OK (doesn't use sh) system "echo $mine"; # Insecure until PATH set system "echo $hid"; # Insecure two ways $path = $ENV{PATH}; # $path tainted $ENV{PATH} = '/bin:/usr/bin'; $ENV{IFS} = '' if $ENV{IFS} ne ''; $path = $ENV{PATH}; # $path now NOT tainted system "echo $mine"; # OK, is secure now! system "echo $hid"; # Insecure via $hid still open(OOF, "<$arg"); # ok (read-only file) open(oof, "> $arg" ); # insecure (trying to write) open(oof, "echo $arg|" ); # insecure via $arg, but... open(oof,"-|") or exec 'echo', $arg; # considered ok $shout=`echo $arg`; # insecure via $arg unlink $mine, $arg; # insecure via $arg umask $arg; # insecure via $arg exec "echo $arg" ; # single arg to exec or system is insecure exec "echo" , $arg; # considered ok (doesn't use the shell) exec "sh" , '-c', $arg; # considered ok, but isn't really ***** sub is_tainted { not eval { join('',@_), kill 0; 1; }; } ***** if ($addr=~ /^([-\@\w.]+)$/) { $addr=$1; # $addr now untainted } else { die "Bad data in $addr" ; # log this somewhere } ***** use english; die unless defined $pid=open(KID, "-|" ); if ($pid) { # parent while () { # do something } close KID; } else { $EUID = $UID; $EGID = $GID; # XXX: initgroups() not called $ENV{PATH} = "/bin:/usr/bin"; exec 'myprog', 'arg1', 'arg2'; die "can't exec myprog: $!"; } ***** #define REAL_FILE "/path/to/script" main(ac, av) char **av; { execv(REAL_FILE, av); } ***** print &q(<"eot"); : #!$bin/perl : eval 'exec $bin/perl -s \$0 \${1+"\$@"}' : if \$running_under_some_shell; : eot ***** print <<"end"; stuff blah blah blah ${ \( expr ) } blah blah blah blah blah blah @{[ list ]} blah blah blah nonsense end ***** a2p -7 -nlogin.password.uid.gid.gcos.shell.home ***** #!/usr/bin/perl use mydecryptfilter; @*x$]`0un&k^zx02jz^x{.?s!(f;9q/^a^@~~8h]|,%@^p:q-=... ***** #!/usr/bin/perl use filter::exec "a2p" ; 1,30{print $1} ***** perl -mo=C foo.pl>foo.c *****