Never been to DZone Snippets before?

Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world

« Newer Snippets
Older Snippets »
Showing 1-10 of 96 total  RSS 

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

// 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 (<FH>) {
	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

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

Retrieve Cisco router traffic statistics using perl and RRDTOOL and PHP

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

// 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

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

#!/usr/bin/perl
#==========================================================================================
# howmany -- a tool for determining how many different types of files are in a folder
#------------------------------------------------------------------------------------------
# Author: Elliot Winkler <elliot.winkler@gmail.com>
# 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

#!/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=<STDIN>)
{
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)

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

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

// 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 (<FH>) {
        chomp();
        my ($report,$expected,$url) = split /;/;
        datamart_testurl($report,$url,$expected);
}
close FH;

# <<<< Main code here

« Newer Snippets
Older Snippets »
Showing 1-10 of 96 total  RSS