Whitespace Matters

Mark Jason Dominus just released SuperPython 0.91, “a Perl source filter for the SuperPython language, allowing SuperPython code to be embedded into Perl programs”.
In terms of language, it goes way beyond python itself to give proper semantics to whitespace. For instance, here is the Hello World program written in SuperPython:

#!/usr/bin/perl
use SuperPython;



                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                               

Ain’t it neat? Naturally, the result is

$ ./hello.spy
Hello, world.

just as would be expected.
If you want to try this program yourself you might be surprised to find out that copy+paste won’t work, but that’s a small price to pay in exchange or the benefits of the richness of syntax and expresiveness of the language, and anyway you may download the source code for hello.spy right here.
Mark is very optimist in contributing the new features of SuperPython back to python itself, and has kindly offered to work closely with the Python community to see this happen.
Congrats Mark, and keep up the good work!

[tags]code, perl, python, computer languages[/tags]

md5pass

This snippet is a simple wrapper around Digest::MD5‘s md5_base64() builds unsalted MD5 digests encoded in base64, very useful for LDAP management and LDIF file processing.

#!/usr/bin/perl
++$|;

use Digest::MD5 qw(md5_base64);

if(!defined($pass=shift)) {
        print "> ";
        $pass=<STDIN>;
        chomp $pass;
}
print encrypted($pass)."\n";

sub encrypted {
        my($passwd) = @_;
        return '{md5}'.md5_base64($passwd).'==';
}

(Source code)

Use it as such:

$ bin/md5pass
> password
{md5}X03MO1qnZdYdgyfeuILPmQ==

[tags]Perl, MD5, code, code snippet[/tags]

Some lovely ASCII Art

Andrew Savige’s Bottles of Beer have been found by the Python pundits (and by some gutless Perl defectors ;-) ) and are being waved as a textbook executable-line-noise example. There’s people that can’t stand beauty when they see it.
Bottles of Beer
(That code is now an image -see below- but you can always get the original source code).
Yup, it is a Perl program. Yes, it *does* run, with interesting results. There’s even a CPAN module — Acme::EyeDrops — that turns your own Perl programs into purposely unmaintainable yet beautiful works of art that can make the entire Python Party cringe in disgust. You have to admit that there’s certain merit in making grown men cry. Automatically, no less. Go and read how it’s done.
So the Obfuscated Python Contest is incredibly boring. I couldn’t care less.
Via Carlos de la Guardia/Marc Abramowitz/Chris Petrilli.
Update 20060916: Replaced the code with a graphical version because WordPress 2.0 doesn’t play well with the text hightlight plugin.
[tags]Perl, Python, Obfuscation, ASCII art[/tags]

Find out LDAP client IPs

ips.pl is a simple perl filter that processes SunONE Directory Server 5.2 access logs to find out the IP addresses that queries are coming from. It’s very useful to evaluate the impact for migrating LDAP infrastructures. Most comments and variable names are in spanish but the code should be clear enough to any SODS sysadmin. Or drop me a line if you absolutely need an all-english version.

#!/usr/bin/perl
# ips.pl $Revision: 1.1 $
# Analiza archivos access de Sun ONE Directory Server 5.2 para generar
# reporte de IPs de clientes y servidores
# Copyright (C) 2005 Javier Arturo Rodriguez
use strict;
my($acceso);
my $filename = shift @ARGV;
die("Usage:\t$0 <filename>\n\tbunzip2 -c <filename.bz2> | $0 -\n") unless $file
name;
open(FILE,"<$filename");
while(<FILE>) {
        chomp;
        if($_=~m,^\[(.*?)\].*?connection from ([\d\.]+) to ([\d\.]+),) {
                $acceso->{$3}->{$2}->{TS}=$1;
                ++$acceso->{$3}->{$2}->{CNT};
        }
}
close(FILE);
foreach my $dst (sort keys %{$acceso||{}}) {
        print "Acceden a traves de $dst\n";
        foreach my $src (
                reverse sort { $acceso->{$dst}->{$a}->{CNT} <=> $acceso->{$dst}
->{$b}->{CNT} }
                keys %{$acceso->{$dst}||{}}
        ) {
                printf("  %-15s (last seen on %s; %d hit%s)\n",
                        $src,
                        $acceso->{$dst}->{$src}->{TS},
                        $acceso->{$dst}->{$src}->{CNT},
                        $acceso->{$dst}->{$src}->{CNT}==1?'':'s',
                );
        }
}

(Download)

countdown

This small script is an alternative to sleep(1) that gives a visual clue to the user about the remaining seconds in the delay

#!/usr/bin/perl
$|++;

my $secs = shift;
die("Usage: $0 <secs>\n") unless (defined $secs) && ($secs>=0);
while($secs>0) {
        printf("\r% 4d", $secs);
        sleep 1;
        --$secs;
}
print "Done          \n";

(Download)
There are numerous instances where you might want your shell scripts to sleep(1) giving the user a clue about what’s going on, but just to relate to a previous example, let’s see how this can be used to throttle file leeching:

$ for i in `count 1 10 %02d`; do wget http://..../file-$i.pdf; countdown 30; done

count

count is a minimalist perl script in the spirit of seq(1) but with a simpler syntax. It only counts in increments of 1, but -on the other hand- it knows how to count down.

#!/usr/bin/perl
use strict;
my($from,$to,$fmt,$inc)=@ARGV;
$to||=$from;
$fmt||="%d";
print join("\n",map{sprintf("$fmt",$_)}($from>$to?reverse($to..$from):($from..$to))),"\n";

(Download)
For instance, “count 10 1 %03d” will count down from 10 to 0 padding with zeroes to three digits. “count 0 15 %x” will count in hex. If you omit the format string it will default to “%d” (decimal, no padding).
count is very useful -among other things- for file leeching:

$ for i in `count 1 10 %02d`; do wget http://..../file-$i.pdf; done

de64

Base64 is used to encode binary data in printable ASCII form. de64 is a trivial perl script to decode such strings:

#!/usr/bin/perl
use MIME::Base64;
local $/ = undef;
print decode_base64(shift||<STDIN>);

(Download)
One application of de64 is decoding UTF8 LDAP attributes inside LDIF files. For instance, “cn:: Um9iZXJ0byBNYXJ0w61uZXo=” may be decoded with

$ de64 Um9iZXJ0byBNYXJ0w61uZXo=
Roberto Martí­nez

(Look Randal! I’m using a CPAN module this time! ;-) ) Of course, all the heavy lifting is done by MIME::Base64 from CPAN.

perlwhich

Are you wondering where the heck does some arcane module come from? Wonder no more, perlwhich comes to the rescue:

#!/usr/bin/perl
use strict;
use File::Spec;

my $module = shift @ARGV;
$module=~s,\.,,igs;
my $pm=$module.'.pm';
my @path = split(/::/,$pm);
my $found = 0;
foreach my $dir (@INC) {
        my $file = File::Spec->catfile($dir,@path);
        if(-f $file) {
                print $file,"\n";
                $found=1;
        }
}
exit(!$found);

(Download)
Next time you need to know some module’s path just run it like this:

$ perlwhich Data::Dumper
/usr/lib/perl/5.8/Data/Dumper.pm

If a module resides in multiple locations under @INC, perlwhich will let you know as well:

$ perlwhich Salesforce
/usr/local/lib/site_perl/Salesforce.pm
/usr/local/share/perl/5.8.4/Salesforce.pm

Luhn algorithm in Perl

Here’s an implementation of the Luhn algorithm in perl.

#!/usr/bin/perl
use strict;
my $number = shift(@ARGV) || die("Usage: $0 <number>\n");
$number=~s,[^0-9],,g;
my($sum,$odd);
foreach my $n (split(//,$number)) {
        $odd=!$odd;
        if($odd) {
                $sum+=$n;
        } else {
                my $x=2*$n;
                $sum+=$x>9?$x-9:$x;
        }
}
my $ok = 0+(($sum%10)==0);
exit(($sum%10)!=0);

(Download)

This program was designed for shell scripting, using something like

$ if ./luhn 457623486; then echo "ok"; else echo "error"; fi
ok

but it should be trivial to modify it for other purposes.
I’m using this algorithm to validate GSM IMEI numbers, but the Luhn algorithm is also behind credit card numbers.

Phonetize

A small filter to phonetize STDIN into the NATO phonetic alphabet. It’s very useful to spell passwords over the phone.

#!/usr/bin/perl
use strict;
my %ALPHA = map {uc(substr($_,0,1))=>$_} qw( Alpha Bravo Charlie Delta Echo Foxtrot Golf Hotel India Juliett Kilo Lima Mike November Oscar Papa Quebec Romeo Sierra Tango Uniform Victor Whiskey X-ray Yankee Zulu );
while(<STDIN>) {
        chomp;
        print $_, "\n";
        print join(' ',map {$ALPHA{uc($_)}||$_} (split(//,$_))),"\n";
}

Here’s the source code.
Yup, I know about Lingua::Alphabet::Phonetic::NATO but I needed a quick script without module dependencies. Yes, I haven’t been able to learn the NATO phonetic alphabet yet -unlike some geeks with too much time in their hands (you know who you are)- and yes, I know I’m lazy, but that’s why I am a perl fan anyway ;-) .
There’s more information about this alphabet atWikipedia. You migth want to donate a few bucks while you’re there.