PERL Examples

Skeleton PERL Scripts

pl2py.pl

#!/usr/bin/env perl
#
#  $Id:$
#

if ( $#ARGV != 0 ) {
   printf "Enter basename of file to convert (i.e. no extension!)\n";
   exit(0);
}

$file = $ARGV[0];

print $file;

$pl = $file . ".pl";
$py = $file . ".py";

open IN,  "<$pl";
open OUT, ">$py";

while (<IN>) {
   chop();

   $_ =~ s'/usr/bin/perl'/usr/bin/env python'g;
   $_ =~ s/::/./g;
   $_ =~ s/\$//g;
   $_ =~ s/;//g;
   $_ =~ s/use/import/g;

   printf OUT "%s\n", $_;
}

close IN;
close OUT;

system("chmod +x $py")

Edit File

#!/usr/bin/env perl

$file = "llheader_jar.log";

open IN, "< $file";
open OUT, "> ntlm.txt";

$typeFlg = -1;

while (<IN>) {
   chop();
   s/
//;

   /^Authorization: / && do {
      if ( $typeFlg == 0 ) {
         $typeFlg = 1;
         s/.*Negotiate  *//;
      } else {
         $typeFlg = 3;
         s/.*Negotiate  *//;
      }

      printf OUT "::%d::  %s\n", $typeFlg, $_;
   };

   /^Parameter \"WWW/ && do {
      next if /Negotiate\"/;
      /NTLM/ && do {
         $typeFlg = 0;
         s/"$//;
         s/.*"//;
         printf OUT "::0::  %s\n", $_;
      };

      /Parameter \"WWW-Authenticate\"  Value \"Negotiate / && do {
         $typeFlg = 2;
         s/.*Negotiate  *//;
         s/"$//;
         printf OUT "::2::  %s\n", $_;
      };

      #printf "%s\n", $_;
   };
}

close IN;
close OUT;

fix.pl

#!/usr/local/bin/perl

open IN,  "< xx.c";
open OUT, "> new.c";

$cnt = 0;

while (<IN>) {
   chop();

   /\/\/ <[0-9][0-9][0-9][0-9]>/ && do {
      s/[0-9][0-9][0-9][0-9]/%04d/;
      $l = sprintf $_, $cnt++;
      $_ = $l;

      printf "%s\n", $_;
   };

   printf OUT "%s\n", $_;
}


close( OUT );

parser.pl

#!/usr/bin/perl

use IO::Handle;

STDOUT->autoflush(1);
my($total, $current, $icmp);
$current=1;
$icmp=0;

        init_parser();
        $total=get_info();      

    foreach $linia (<STDIN>){
        printf("\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b\b");
        printf("Analysing line $current of $total");
        $current++;

        if($linia=~/^.+\s.+\s>>>>\s.+\s.+\s.+/){
            my($proto, $srcip, $nic, $dstip, $date, $time)=split(' ', $linia);
            $srcip=~tr/:/./;
            $dstip=~tr/:/./;
            if($proto eq "ICMP"){$icmp=1;}
            if(($proto ne "ICMP") && $icmp==1){print PLIK "$linia";goto blah;}
                    
            open(PLIK, ">>./$proto/$srcip-$dstip")|| die "Can`t open file ./$proto/$srcip-$dstip: $!\n";
             if(($proto eq "ICMP")){ print PLIK "$linia";}
             
            
            blah:
            }
            else{
                if($linia=~/--end-of-icmp-packet/){
                    $icmp=0;
                    print PLIK "\n";
                }
                else{
            
            $linia=~s/^\n$//;
            print PLIK "$linia";
            }
            }
                
        }

printf("\n");       
            
sub init_parser{

    if(!(-d "./TCP")){
        mkdir("./TCP", 0744) || die "Can`t create \"tcp\" directory: $!\n";
        }
    if(!(-d "./UDP")){
        mkdir("./UDP", 0744) || die "Can`t create \"udp\" directory: $!\n";
        }
    
    if(!(-d "./ICMP")){
        mkdir("./ICMP", 0744) || die "Can`t create \"icmp\" directory: $!\n";
        }
}
 
sub get_info{
    
my($tem, $counter);
$counter=0;

    foreach $tem (<STDIN>){
        $counter++;
        }
    seek(STDIN, 0, SEEK_SET);   
        
return $counter;
}