Archive for Tag "perl"

Perl WideFinder

// perl script to parse text file, uses MMAP and Forking

#!/usr/bin/perl -s
## wf.pl -- an implementation of the "wide finder" benchmark.
## Sean O'Rourke, 2007, public domain.
##
## Usage: perl -s wf.pl -J=$N $LOGFILE
##     where $N is the number of processes, and $LOGFILE is the target.
##
## This code depends on Sys::Mmap, which is available on CPAN.

use Sys::Mmap;
use strict qw(subs refs);

$J ||= 0;

my $file = shift;

open IN, $file or die $!;
my $str;

mmap $str, 0, PROT_READ, MAP_SHARED, IN;

my %h;
my $n = 0;

if ($J == 0) {
    ## serial
    $h{$1}++ while $str =~ m{GET (/sms/umb/[^?]+)\?OPCODE=CPDELIVER&MSISDN=}g;
} else {
    $|=1;
    ## parallel -- ugh.
    my $size = -s IN;
    my $nperj = int(($size + $J - 1) / $J);
    my @fhs;
    use Storable qw(store_fd fd_retrieve);
    for my $i (0..$J-1) {
        my $pid = open my $fh, "-|";
        die unless defined $pid;
        if ($pid) {
            push @fhs, $fh;
        } else {
            pos($str) = $i ? rindex($str, "\n", $nperj * $i) || 0 : 0;
            my $end = ($i+1) * $nperj;
            $h{$1}++ while pos($str) < $end &&
                $str =~ m{GET (/sms/umb/[^?]+)\?OPCODE=CPDELIVER&MSISDN=}g;
            store_fd \%h, \*STDOUT or die "$i can't store!\n";
            exit 0;
        }
    }
    for (0..$#fhs) {
        my $h = fd_retrieve $fhs[$_] or die "I can't load $_\n";
        while (my ($k, $v) = each %$h) {
            $h{$k} += $v;
        }
        close $fhs[$_] or warn "$_ exited weirdly.";
    }
}

for (sort { $h{$b} <=> $h{$a} } keys %h) {
    print "$h{$_}\t$_\n";
    last if ++$n >= 10;
}

Dump HTTP packet Using Tcpdump and Perl

// capture network packet using tcpdump and print in human readable HTTP request and response using perl

#!/usr/bin/perl

use Socket;

$|=1;
open (STDIN,"/usr/sbin/tcpdump -lnx -s 1024 dst port 80 |");
while (<>) {
    if (/^S/) {
        while ($packet=~/(GET|POST|WWW-Authenticate|Authorization).+/g)  {
            $time = localtime;
            $iaddr = inet_aton($client);
            $client_name = gethostbyaddr($iaddr, AF_INET);
            print "[$time] $client ($client_name) -> $host\t$&\n";
        }
        undef $client; undef $host; undef $packet;
        ($client,$host) = /(d+.d+.d+.d+).+ > (d+.d+.d+.d+)/
            if /P d+:d+((d+))/ && $1 > 0;
    }
    next unless $client && $host;
    s/s+//;
    s/([0-9a-fA-F]{2})s?/chr(hex($1))/eg;
    tr/x1F-x7Ern//cd;
    s/0x.?:  //g;
    $packet .= $_;
}