DZone Snippets: perl code

Perl : scan a list of networks, looking for hosts responding on the port 80 (http)

bouffon69 (Sylvain Le Courtois) — Tue, 06 May 2008 07:05:28 GMT

// Input : a list of address of routers, in dotted decimal notation



use strict;

use Net::Ping;

use IO::Socket::INET;



sub isodate() {

        my ($day, $mon, $year, $hour, $min, $sec) = (localtime)[3, 4, 5, 2, 1, 0];

        $mon++; # 0-based index

        $year = $year + 1900;

        my $date = sprintf ("%04i-%02i-%02i %02i\:%02i\:%02i", $year, $mon, $day, $hour, $min, $sec);

        return $date;

}



sub testhost {

       my $p = new Net::Ping("tcp");

       $p->{port_num}=80; 

       my @result = $p -> ping($_[0],2);

       return $result[0];

       }



sub to_dot {

	my $n = shift;

	my @decimal;

	for (1..4) {

		unshift @decimal, $n & 0xFF;

		$n >>= 8;

	}

	return join(".",@decimal);

}



my %dejavu;

open FH,"liste.txt";

while () {

	chomp;

	my ($routeur,$mask)=split;

	

	next if $routeur !~ /\d+\.\d+\.\d+\.\d+$/ or $mask !~ /\d+\.\d+\.\d+\.\d+$/;

	

	next if defined($dejavu{$routeur});

	$dejavu{$routeur}=1;

	

	my ($o1,$o2,$o3,$o4) = split /\./,$mask;

	my $mask=$o1*256**3+$o2*256**2+$o3*256+$o4;

	my $num = $mask ^ 0xFFFFFFFF;

	$num--;



	my ($o1,$o2,$o3,$o4) = split /\./,$routeur;

	my $net=$o1*256**3+$o2*256**2+$o3*256+$o4 & $mask;

	

	#print join("|",$routeur,&to_dot($net),$num)."\n";

	

	print "Starting scanning network ".to_dot($net).", router = ".$routeur."\n";

	print "Adresses demarrant de ".to_dot($net+1)." et finissant a ".to_dot($net+$num).".\n";

	for my $i (1..$num) {

		my $host=to_dot($net+$i);

		if ( &testhost($host) ) {

			print "$host is alive\n";

			my $port=80;

			my $sock = new IO::Socket::INET (PeerAddr => $host,

					     PeerPort => $port,

					     Proto => 'tcp');

			if ($sock){

				close $sock;

				print "$port -open on $host\n";

				open OUT,">>webservers.txt";

				print OUT join("|",isodate(),$host,to_dot($net),$routeur)."\n";

				close OUT;

			}	else	{

				print "$port -closed on $host\n";

			}



		} else {

			print "$host is not responding\n";

		}

	}

}





close FH;

Bashy Perlness for generating Favicon text for OpenSearches

sikelianos (Zeke Sikelianos) — Mon, 21 Apr 2008 19:58:49 GMT



echo -n 'data:image/xicon,' ; perl -ne 's/(.)/"%".unpack("H2",$1)/egs; print' ~/Desktop/favicon.ico ; echo ''

Retrieve Cisco router traffic statistics using perl and RRDTOOL and PHP

adr1an0 (Adr) — Fri, 28 Mar 2008 20:38:22 GMT

Traffic retrieving perl script:



    #!/opt/csw/bin/perl -w

    ##################################################

    # rrdtraf.pl

    #

    # Trafego de equipamentos Cisco

    #

    # 2006.01.12 - Adriano P. 

    # $Id: $



    ######################

    require 5.003;

    use strict;

    use SNMP_Session;

    use BER;

    use SNMP_util "0.90";

    use Time::Local;

    use RRDs;

    use Getopt::Long;

    use Pod::Usage;



    ##### GLOBAL #####

    my %opt;

    my @routers;

    my $IP_APPEND="::2:2";

    my $ERROR;

    my %rrd;



    ##################################################################

    sub main {

    init();



    Options(%opt);



    open(PAR, "rrdtraf.par") || die "Problema ao abrir rrdtraf.parn";



    Msg("* Coletando dados dos switches");

    while () {

    next if grep(/^(#)/,$_);



    my ($community,$ip,$net,@if) = split /:/;

    #$ip = "${community}@${ip}"; #host:port:timeout:retries



    LeituraSNMP($community, $ip,@if);



    syswrite(STDOUT,'.',1) if (!$opt{verbose} && !$opt{V});

    }

    close(PAR);

    Msg("n","* Fim");

    }



    main;

    exit 0;



    ##################################################################

    sub CriaRRD($) {

    my $arquivo = shift;



    print "- Criando base de dados:($arquivo) - " if $opt{verbose};



    RRDs::create ("$arquivo", "--start", time(),

    "--step", "300",

    "DS:ifInOctets:COUNTER:600:0:U",

    "DS:ifOutOctets:COUNTER:600:0:U",

    "RRA:AVERAGE:0.5:1:600",    #2 dias, com amostra de 5min

    "RRA:AVERAGE:0.5:6:700",    #2 semanas, com amostra de 30min

    "RRA:AVERAGE:0.5:24:775",    #2 meses, com amostra de 2h

    "RRA:AVERAGE:0.5:288:400");    #1 ano, com amostra de 1 dia

    if ($ERROR = RRDs::error) {

    die "$0: unable to graph $arquivo: $ERRORn";

    }



    print "okn" if $opt{verbose};

    }



    ##################################################################

    sub LeituraSNMP($$$) {

    my $community = shift;

    my $ip = shift;

    my (@if) = @_;



    my ($idx, $arquivo);

    my $ifInBroadcastPkts = "1.3.6.1.2.1.2.2.1.12";

    my $ifOutBroadcastPkts = "1.3.6.1.2.1.2.2.1.18";

    my @oids = ('ifIndex','ifDescr','ifInOctets','ifOutOctets');



    my @stack = &SNMP("${community}@${ip}", @oids);

    #$ip =~ s/.*@//;



    print "--[ $ip ]-----------n" if $opt{verbose};



    foreach $idx (@stack) {

    my ($id,$nome) = SNMP_util::Check_OID('ifDescr');

    next if (!${$idx}{$id});

    # Ignora interfaces nao cadastradas

    if( !grep(/^${$idx}{$id}$/,@if) ) {

    next;

    }



    my @dados = ();

    $dados[0] = $ip;                # 1: ip

    @dados[1,2,3,4] = &Dados($idx,@oids);

    my $ifIndex = $dados[1];



    $arquivo = "${ip}_${ifIndex}.rrd";

    if (! -e "$arquivo") {

    CriaRRD($arquivo);

    }

    AtualizaRRD($arquivo, @dados);

    }

    }



    ##################################################################

    sub AtualizaRRD(@) {

    my $arquivo = shift;

    my (@dados) = @_;



    print "- $dados[0], $dados[1], $dados[2], $dados[3], $dados[4]n" if $opt{verbose};



    RRDs::update ($arquivo, "N:$dados[3]:$dados[4]");

    }



    ##################################################################

    sub GrafRRD {

    my ($start_date,$eqto) = @_;



    print "Gerando grafico ($start_date)...";



    my @option = ("-s", $start_date, "-w", "600", "-h", "170",

    "-e", "now", "--alt-autoscale", "-l 0",

    "-x", "HOUR:1:DAY:1:HOUR:2:0:%H");



    if ($start_date >= 2) {



    ######################

    # GRAPH 1

    RRDs::graph ("$eqto.gif", @option,

    "DEF:in=$eqto.gif:ifInOctets:AVERAGE",

    "DEF:out=$eqto.gif:ifOutOctets:AVERAGE",

    "LINE2:c13#0000aa:Entrada",

    "LINE2:c14#ff66ff:Saida");

    if ($ERROR = RRDs::error) {

    die "$0: unable to graph $eqto.gif: $ERRORn";

    }



    }



    print "okn";

    }



    ##################################################################

    sub SNMP($@) {

    my $ip = shift;

    my @oids = @_;



    my $ip_="$ip${IP_APPEND}";

    my ($idx,$oid,@stack);



    foreach my $tuple (snmpwalk($ip_, @oids)) {

    my($var,$counter) = split /:/, $tuple, 2;

    $idx = substr($var, rindex($var,'.')+1);

    $oid = substr($var, 0, length($var)-length($idx)-1);

    #warn "* $vart$countern" if $opt{V};

    $stack[$idx]{$oid} = $counter;

    }



    return @stack;

    }



    ##################################################################

    sub Dados($$) {

    my $var = shift;

    my @oids = @_;



    my @dados = ();



    for(my $i=0; $i  2) if $$opt{man};

    }



    ##################################################################

    sub init {

    # queue up reading the MIB file

    #&snmpQueue_MIB_File("/home/adr/mibs/IWFG.MIB");

    $SNMP_Session::suppress_warnings = 2;

    $SNMP_util::Debug = 0;

    $= = 1000;

    }



    #eof

rrdtraf.par - sample file



    community:10.1.2.3:Comment:FastEthernet0/1:FastEthernet0/2

    community:10.1.2.4:Comment:FastEthernet0/1

    community:10.1.2.5:Comment:FastEthernet0/1:FastEthernet0/2:FastEthernet0/12:FastEthernet0/18

PHP script to plot the traffic graph:



    {!--

    ##################################################

    # rrdgraph.php

    #

    # Plotagem dos graficos de arquivos rrd

    #

    # 2006.01.12 - Adriano P.

    # $Id: $

    --}

    {?php

    $display = $_GET['display'];



    if ($display == 'image') {



    header ("Content-type: image/png",false);



    $display = $_GET['display'];

    $rrdtool = "/opt/csw/bin/rrdtool ";

    $graph_opt =     "--height 150 --width 550 " .

    "--start -172800 ".

    "--imgformat PNG ".

    "--no-minor ".

    "-c BACK#ffffff ".

    "-c SHADEA#ffffff ".

    "-c SHADEB#ffffff ".

    "-c FRAME#ffffff ".

    "-v 'bits/seg' -L 8  ";



    $arq1="/home/aprado/proj/traf/".$_GET['arq1'];



    $graph =

    "DEF:in1=$arq1:ifInOctets:AVERAGE ".

    "DEF:out1=$arq1:ifOutOctets:AVERAGE ".

    "CDEF:in1_bps=in1,8,* ".   #NÃO ESQUECER DE MULTIPLICAR POR 8

    "CDEF:out1_bps=out1,8,* ".  #(1 byte = 8 bits)

    "HRULE:0#000000:'       ' ".

    "AREA:in1_bps#6699cc:'Saida' ".

    "LINE2:out1_bps#003399:'Entrada' ";



    # function for rrdtool execution

    function rrdtool_execute($rrdtool, $command) {

    return fpassthru(popen($rrdtool . $command, "r"));

    }



    $command = $graph_opt . $graph;

    return rrdtool_execute($rrdtool, " graph - $command");

    }

    ?}



    {HTML}

    {HEAD}

    {STYLE TYPE="text/css"}

    H1 {

    font-weight: bold;

    font-size: 18pt;

    line-height: 18pt;

    font-family: arial,helvetica;

    font-variant: normal;

    font-style: normal;

    }

    BODY {

    color: black;

    background-color: white;

    font-size: 11pt;

    line-height: 12pt;

    font-family: arial,helvetica;

    font-variant: normal;

    font-style: normal;

    }

    {/STYLE}

    {/HEAD}

    {BODY}



    {CENTER}

    {TABLE}

    {?php



    function graphit($arq1, $descr1) {

    print "{tr align='center'}{td}{font color='#003399'}{b}$descr1{/b}{/font}{br}n";

    print "{/td}{/tr}n";

    print "{tr}{td align='center'}{img xsrc='/traf/rrdgraph.php?display=image&arq1=$arq1' border='0'}";

    print "{hr width='100%' size='2'}{/td}{/tr}n";

    }



    graphit("10.1.2.3_2.rrd","10.1.2.3 - f0/1: Comentario");

    graphit("10.1.2.3_3.rrd","10.1.2.3 - f0/2: Comentario");



    ?}

    {/TABLE}

    {/CENTER}

    {/BODY}

    {/HTML}

Split Apache logs according to GeoIP country

iansealy (Ian Sealy) — Wed, 19 Mar 2008 15:02:26 GMT

// Split Apache logs according to GeoIP country



#!/usr/bin/perl



# $Id$



# Split Apache logs according to GeoIP country



use strict;

use warnings;



## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)

our ($VERSION) = '$Revision$' =~ m{ \$Revision: \s+ (\S+) }xms;

## use critic



use Geo::IP;



my $gi = Geo::IP->open('/usr/local/share/GeoIP/GeoIPCity.dat', GEOIP_STANDARD);



my @logs = @ARGV;



my %record_for;



foreach my $log (@logs) {

    die "Can't read $log\n" if !-r $log;

    

    my %fh_for;

    my $num_lines_parsed = 0;

    

    my $log_fh;

    if ($log =~ m/ \.gz \z /xms) {

        open $log_fh, "gzip -cd $log |" or die "Can't open gzip pipe\n";

    }

    else {

        open $log_fh, '<', $log or die "Can't open $log\n";

    }

    

    my $log_base = $log;

    $log_base =~ s/ \.gz \z //xms;

    

    while (my $line = <$log_fh>) {

        $num_lines_parsed++;

        if (!($num_lines_parsed % 1000)) {

            print STDERR "Parsed $num_lines_parsed lines of $log\n";

        }

        

        my ($host) = $line =~ m/ \A (\S+) \s /xms;

        

        if (!exists $record_for{$host}) {

            my $record = $gi->record_by_name($host);

            $record_for{$host} = $record || 0;

        }

        

        my $country = 'unknown';

        if (exists $record_for{$host} && $record_for{$host}) {

            $country = lc($record_for{$host}->country_name());

            $country =~ s/\W+/_/gxms;

        }

        

        if (!exists $fh_for{$country}) {

            open $fh_for{$country}, '>', "$log_base.$country.out"

                or die "Can't write to $log_base.$country.out\n";

        }

        

        print {$fh_for{$country}} $line;

    }

    

    foreach my $fh (values %fh_for) {

        close $fh;

    }

    

    close $log_fh;

}

Rapleaf Address Book API in Perl

dannymo2 (Dan Scudder) — Fri, 14 Mar 2008 14:39:58 GMT

Retrieve e-mail contacts from several services using the Rapleaf Address Book API.

It accesses the Rapleaf API Web server and executes a request to retrieve the contact list of a given user of either Gmail, Yahoo, Hotmail and AOL.

Returns an associative array with the contacts names and e-mail addresses, as well the HTTP response status and any errors.



package Rapleaf;

use strict;



use LWP::UserAgent;

use HTTP::Request;

use XML::Simple;



sub getData {

	my ($email, $pass, $api_key, $url) = @_;

	my $post_data = "login=$email&password=$pass";



	$url ||= 'http://api.rapleaf.com/v2/abook';

	my $agent = LWP::UserAgent->new();

	my $request = HTTP::Request->new(POST => $url);

	$request->content($post_data);

	$request->header( 'Authorization' => $api_key );

	my $response;

	$response = $agent->request($request);

	my %result; 

	if($response->code == 200) {

		my $xml = new XML::Simple;

		%result = %{$xml->XMLin($response->content)};



		# if a single contact if found, XMLin returns a result set of a different format, therefore we need to manually format it

		if ($result{'contact'}->{'name'}) {

			$result{'contact'}->{$result{'contact'}->{'name'}} 

				= {'email'=>$result{'contact'}->{'email'}};

			delete $result{'contact'}->{'name'};

			delete $result{'contact'}->{'email'};

		} 

	} elsif ($response->code == 400) {

		$result{'error'} = 'The request did not contain all required parameters: '.$response;

	} elsif ($response->code == 401) {

		$result{'error'} = 'API key was not provided or is invalid.';

	} elsif ($response->code == 420) {

		$result{'error'} = 'Login failed.';

	} elsif ($response->code == 500) {

		$result{'error'} = 'There was an unexpected error on our server. This should be very rare and if you see it please contact developer@rapleaf.com.';

	} elsif ($response->code == 520) {

		$result{'error'} = 'There was an error while reading the contacts from the address book.';

	}

	

	$result{'status'} = $response->code;

	return \%result;

}



1;

howmany

mcmire () — Tue, 11 Mar 2008 14:57:12 GMT



#!/usr/bin/perl

#==========================================================================================

# howmany -- a tool for determining how many different types of files are in a folder

#------------------------------------------------------------------------------------------

# Author: Elliot Winkler 

# Created: 11 Mar 2008

#==========================================================================================



my $dir = $ARGV[0] || ".";

my $cmd = "find $dir";

my @listing = sort grep { $_ } split /\n/, `$cmd`;



my %exts;

for (@listing) {

  my($ext) = /\.([a-z]+)$/;

  next unless $ext;

  $exts{lc $ext}++;

}



for (sort keys %exts) {

  print uc($_).": ".$exts{$_}."\n";

}

Example:


$ cd ~/docs

$ howmany

CSV: 3

DOC: 1

KEY: 1

PUB: 1

SQL: 1

TEXT: 1

TXT: 9

XCF: 2

XLS: 1

ZIP: 1

$ howmany ~/docs

CSV: 3

DOC: 1

KEY: 1

PUB: 1

SQL: 1

TEXT: 1

TXT: 9

XCF: 2

XLS: 1

ZIP: 1

Note: This only works on Linux/Unix, because it relies on a Linux/Unix-only command to pull up the list of files. A future update may include support for Windows, though it would be pretty easy to find out how to fix it.

vortx.pl

netfish (netfish) — Fri, 01 Feb 2008 16:11:43 GMT

#!/usr/bin/perl -w
# Vortex0.pl
#----------------

use strict;
use Socket;

# initialize host and port
my $host = shift || 'localhost';
my $port = shift || 5842;
my $server = "vortex.labs.pulltheplug.org";

# create the socket, connect to the port
socket(SOCKET,PF_INET,SOCK_STREAM,(getprotobyname('tcp'))[2])
or die "Can't create a socket $!\n";
connect( SOCKET, pack( 'Sn4x8', AF_INET, $port, $server ))
or die "Can't connect to port $port! \n";

my $comm;
while($comm=)
{
chomp $comm;

if($comm ne '')
{

print "\n Received 4-Byte Password '", $pass,"'\n";
$SOCKET->recv($pass,4);

print "\n Sending message '",$pass,"'";
if($SOCKET->send($pass))
{
print "[Done] CONGRATS! Time for some Vodka","\n";
}
}

else
{
# Send an empty message to server and exit
$SOCKET->send($pass);
exit 1;
}
}

close SOCKET or die "close: $!";

Interactive Text-to-Speech (Windows, Perl)

minitotoro (Natalie) — Mon, 28 Jan 2008 19:59:29 GMT

This script calls the Windows OLE for the built in TTS. Type what you want the computer to say at the prompt and hit enter. To quit type ":q" (minus the quotation marks).



use Win32::OLE qw( EVENTS );



get_text();



sub get_text{

	$output_speech = ;

	chomp($output_speech);

	if($output_speech ne ":q"){

		say_this();

		get_text();

	}

}



sub say_this{

	my $myTTS = new Win32::OLE( "Sapi.SpVoice" ); 

	$myTTS->Speak( "$output_speech" );

	while( $myTTS->{Speaking} )

	{

		Win32::OLE->SpinMessageLoop();

		Win32::Sleep( 100 );

	}

}

find and replace text from the shell

sikelianos (Zeke Sikelianos) — Fri, 12 Oct 2007 19:02:38 GMT

Snagged from http://snippets.dzone.com/posts/show/116



find . -name '*.txt' -print0 |xargs -0 perl -pi -e 's/find/replace/g'

Browser automation using perl LWP

bouffon69 (Sylvain Le Courtois) — Fri, 28 Sep 2007 11:48:47 GMT

// This is a sample code used to measure reports response times on a OAS application.



#!/usr/bin/perl

#

# LWP connection to the Datamart Portal

# Timing of the main reports

#



use strict;

require LWP::UserAgent;



my $ua = LWP::UserAgent->new;



sub isodate() {

        my ($day, $mon, $year, $hour, $min, $sec) = (localtime)[3, 4, 5, 2, 1, 0];

        $mon++; # 0-based index

        $year = $year + 1900;

        my $date = sprintf ("%04i-%02i-%02i %02i\:%02i\:%02i", $year, $mon, $day, $hour, $min, $sec);

        return $date;

}



sub datamart_login {

        my ( $user, $pass ) = @_;

        my $time_begin=time();

        my $url='http://daprd:7782/portal/page?_pageid=37,134413,37_134422&_dad=portal&_schema=PORTAL';

        my $req = HTTP::Request->new( GET => $url );

        my $resp = $ua->request($req);

        my $loginform = $resp->content ;

        if ( $loginform !~ /Entrez votre nom utilisateur/ ) {

                die isodate()." Failed to get the logon page of the Web Site\n";

        } else {

                my $locale="";

                my ($v) = $loginform =~ /NAME=\"v\" value=\"(.+)\"/;

                my ($site2pstoretoken) = $loginform =~ /NAME=\"site2pstoretoken\" value=\"(.+)\"/;

                my ($submiturl) = $loginform =~ /form method=\"POST\" action=\"(.*?)\"/;

                $resp = $ua->post( $submiturl,

                   [

                     ssousername => $user,

                     password => $pass,

                     v => $v,

                     locale => $locale,

                     site2pstoretoken => $site2pstoretoken

                   ],

                );

                $resp = $ua->get($url);

                $resp = $ua->get($url);

                if ( $resp->content !~ /Crit..res de recherche/ ) {

                        die isodate()." Failed to get the main page of Portal\n";

                }

        }

        print join(";",isodate(),"Time to log on the Portal",time()-$time_begin,$url)."\n";

}



sub datamart_testurl {

        my ($label,$url,$expected)=@_;

        my $time_begin=time();

        my $resp;

        $resp = $ua->get($url);

        $resp = $ua->get($url) if $resp->content !~ /$expected/;        # We try two times !

        if ( $resp->content !~ /$expected/ ) {

                print STDERR isodate()." Test Failed on $label. $expected not found in response.\n";

                print STDERR $resp->as_string;

        } else {

                print join(";",isodate(),$label,time()-$time_begin,$url)."\n";

        }

}



$ua->timeout(1200);

$ua->cookie_jar({});

$ua->agent( 'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)' );

#push @{ $ua->requests_redirectable }, 'POST';



# >>>> Main code here



datamart_login("xxxx","xxxx");



open FH,"/exploit/scripts/appli/check_datamart.ini" or die "Unable to open check_datamart.ini";

while () {

        chomp();

        my ($report,$expected,$url) = split /;/;

        datamart_testurl($report,$url,$expected);

}

close FH;



# <<<< Main code here