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 (<STATUS>) {

    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 = <Reader>;

*****

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 (<KID>) {

        # 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

*****

