The normal ‘logger’ command sends Syslog messages using the machine’s IP address, so logger wasn’t very useful. The only thing useful seem to be, to generate my own Syslog packets in which I spoof the source address. After writing this handy little script, I realized that I’ve actually created a monster. A very evil scary kinda looking mean monster! I will show an example for creating Syslog event generator (and later on one for creating SNMP events), but the code can be used for much more. Please keep in mind I post this code just for educational and debugging reasons. If you want to use it for other reasons… well that’s up to you!

The example shown overhere is a bit more worked out and put in an object oriented structure. It could have also been a simple quick and dirty script.

The module we will use is called Net::RawIP and it will allow us to create our TCP or UDP packets. We just need to figure out how packets should be created in order for the Syslog daemon to accept them.

At first I’ve created a Packet.pm class. This is the main base class, which creates the constructor and defines the class interface.

package Packet;
# $Id: Packet.pm 828 2011-06-28 13:05:03Z insaniac $
use strict; use warnings;
use Net::RawIP;

sub new {
    my($class, $opts) = @_;

    my $self = bless {}, $class || ref $class;
    $self->{rawip} = Net::RawIP->new($opts);

    return $self;
}

sub pkt_payload {
}

sub pkt_size {
}

sub pkt_debug {
}

sub pkt_send {
    my($self, $delay, $amount) = @_;

    $self->pkt_debug();
    $self->{rawip}->send($delay, $amount);
}

1;

Secondly I’ll need an UDP base class, from which the Syslog module will inherit.

package Packet::UDP;
# $Id: UDP.pm 837 2011-06-28 15:05:10Z insaniac $
use strict; use warnings;
use base qw/Packet/;
use POSIX qw{strftime};

#
# src => IP:PORT
# dst => IP:PORT
#
sub new {
    my($class, $src, $dst) = @_;
    my($saddr, $sport) = split /:/, $src;
    my($daddr, $dport) = split /:/, $dst;

    my $self = $class->SUPER::new({
            ip => {
                saddr    => $saddr,
                daddr    => $daddr,
                frag_off => 0,
                tos      => 0,
                id       => $$ + strftime('%s', localtime()),
            },
            udp => {
                source => $sport,
                dest   => $dport,
            },
            });
}

sub pkt_size {
    my($self)= @_;

    my($src, $dst, $data) = $self->{rawip}->get( {
                udp => [qw/source dest data/]
            },
    );
    my $size = length($src) + length($dst) + length($data);

    # set 'check' to 0 to recalculate the UDP checksum
    $self->{rawip}->set( {
            udp => {
                len   => $size,
                check => 0,
            }
    });

    return $size;
}

sub pkt_payload {
}

sub pkt_debug {
    my($self) = @_;

    my(@udp_fields) = qw/source dest len data/;
    my(@ip_fields)  = qw/version ihl tos id frag_off ttl protocolsaddr daddr/;
    my(@udp_data)   = $self->{rawip}->get({ udp => @udp_fields });
    my(@ip_data)    = $self->{rawip}->get({ ip  => @ip_fields });

    print "IP FIELDSn";
    print "=========n";
    print "- $ip_fields[$_]: $ip_data[$_]n" foreach 0 ..  $#ip_data;
    print "UDP FIELDSn";
    print "=========n";
    print "- $udp_fields[$_]: $udp_data[$_]n" foreach 0 ..  $#udp_data;

}

1;

Having all the base classes in place, we can finally focus on creating our Syslog class, a module which will allow us to send Syslog messages, allowing us to change the source IP address.

package Packet::UDP::Syslog;
# $Id: Syslog.pm 838 2011-06-28 15:08:07Z insaniac $
use strict; use warnings;
use base qw/Packet::UDP/;

sub new {
    my ($class, $src, $dst) = @_;
    my $self = $class->SUPER::new("$src:1666", "$dst:514");
    return $self;
}

# TAG               CODE    DESCRIPTION
# =====================================
# kernel            0       kernel messages
# user              1       user-level messages
# mail              2       mail system
# system            3       system daemons
# security          4       security/authorization messages (note 1)
# internal          5       messages generated internally by syslogd
# print             6       line printer subsystem
# news              7       network news subsystem
# uucp              8       UUCP subsystem
# clock             9       clock daemon (note 2)
# security2        10       security/authorization messages (note 1)
# ftp              11       FTP daemon
# ntp              12       NTP subsystem
# logaudit         13       log audit (note 1)
# logalert         14       log alert (note 1)
# clock2           15       clock daemon (note 2)
# local0           16       local use 0  (local0)
# local1           17       local use 1  (local1)
# local2           18       local use 2  (local2)
# local3           19       local use 3  (local3)
# local4           20       local use 4  (local4)
# local5           21       local use 5  (local5)
# local6           22       local use 6  (local6)
# local7           23       local use 7  (local7)
my $i = 0;
my %fac_map = map {$_ => $i++ } qw/kernel user mail system security internal print news uucp clock security2 ftp ntp logaudit logalert clock2 local0 local1 local2 local3 local4 local5 local6 local7/;

# TAG             CODE    DESCRIPTION
# =====================================
# emerg           0       Emergency: system is unusable
# alert           1       Alert: action must be taken immediately
# crit            2       Critical: critical conditions
# err             3       Error: error conditions
# warn            4       Warning: warning conditions
# notice          5       Notice: normal but significant condition
# info            6       Informational: informational messages
# debug           7       Debug: debug-level messages
$i = 0;
my %sev_map = map {$_ => $i++} qw/emerg alert crit err warn notice info debug/;

sub pkt_payload {
    my($self, $facility, $severity, $msg) = @_;

    my ($fac_sev) = ($fac_map{$facility} << 3) + $sev_map{$severity};
    $self->{rawip}->set({
            udp => { 
                data => "<$fac_sev>$msg�" 
                } 
            }
    );

    # call and set the size
    $self->pkt_size();
}

1;

Our OO structure is now ready, all we need is a script which will call all this code.

#!/usr/bin/perl
use strict; use warnings;
use lib './';
use Packet::UDP::Syslog;
use POSIX qw/strftime/;

my @sources = qw{
    166.59.83.200 166.59.83.1 166.59.83.206 192.168.0.99
    192.168.1.99
};

my @messages = (
        {severity => 'info',  payload => 'the planet is going down'},
        {severity => 'err',   payload => 'BOOM BOOM BOOM'},
        {severity => 'emerg', payload => 'The house is on fire!'},
        {severity => 'alert', payload => "Do NOT forget to feed the monkeysnAnd the bearsnand the cows!"},
        {severity => 'debug', payload => 'We should have a look into this'},
);

foreach my $src (@sources){
    my $syslog = Packet::UDP::Syslog->new($src, "192.168.1.3");
    foreach my $msg (@messages) {
        my $datetime = strftime("%b %d %H:%M:%S", localtime());
        $syslog->pkt_payload('local7', $msg->{severity}, $datetime." $src: ".$msg->{payload});
        $syslog->pkt_send(1,1);
    }
}

Running the script:

root@yamamoto:/home/insaniac/dev/Net# perl raw_pkt.pl
IP FIELDS
=========
- version: 4
- ihl: 5
- tos: 0
- id: 1309286460 
- frag_off: 0
- ttl: 64
- protocolsaddr: 3232235779
UDP FIELDS
=========
- source: 1666   
- dest: 514
- len: 68
- data: <190>Jun 28 17:12:13 166.59.83.200: the planet is going down
IP FIELDS
=========
- version: 4
- ihl: 5
- tos: 0
- id: 1309286460 
- frag_off: 0
- ttl: 64
- protocolsaddr: 3232235779
UDP FIELDS
=========
- source: 1666   
- dest: 514
- len: 58
- data: <187>Jun 28 17:12:14 166.59.83.200: BOOM BOOM BOOM
*** snip output ***

And that’s it! If we would check our receiving network interface (on IP address 192.168.1.3) with tcpdump, we would see our packets arriving:

17:13:24.218196 IP (tos 0x0, ttl 64, id 8359, offset 0, flags [none], proto UDP (17), length 96)
    166.59.83.206.1666 > musashi_vpn.syslog: [udp sum ok] SYSLOG, length: 68
        Facility local7 (23), Severity debug (7)
        Msg: Jun 28 17:13:24 166.59.83.206: We should have a look into this�x00
        0x0000:  3c31 3931 3e4a 756e 2032 3820 3137 3a31
        0x0010:  333a 3234 2031 3636 2e35 392e 3833 2e32
        0x0020:  3036 3a20 5765 2073 686f 756c 6420 6861
        0x0030:  7665 2061 206c 6f6f 6b20 696e 746f 2074
        0x0040:  6869 7300
        0x0000:  4500 0060 20a7 0000 4011 9e31 a63b 53ce
        0x0010:  c0a8 0103 0682 0202 004b cc9e 3c31 3931
        0x0020:  3e4a 756e 2032 3820 3137 3a31 333a 3234
        0x0030:  2031 3636 2e35 392e 3833 2e32 3036 3a20
        0x0040:  5765 2073 686f 756c 6420 6861 7665 2061
        0x0050:  206c 6f6f 6b20 696e 746f 2074 6869 7300
17:13:25.219101 IP (tos 0x0, ttl 64, id 8364, offset 0, flags [none], proto UDP (17), length 88)
    192.168.0.99.1666 > musashi_vpn.syslog: [udp sum ok] SYSLOG, length: 60
        Facility local7 (23), Severity info (6)
        Msg: Jun 28 17:13:25 192.168.0.99: the planet is going down�x00
        0x0000:  3c31 3930 3e4a 756e 2032 3820 3137 3a31
        0x0010:  333a 3235 2031 3932 2e31 3638 2e30 2e39
        0x0020:  393a 2074 6865 2070 6c61 6e65 7420 6973
        0x0030:  2067 6f69 6e67 2064 6f77 6e00
        0x0000:  4500 0058 20ac 0000 4011 d732 c0a8 0063
        0x0010:  c0a8 0103 0682 0202 0043 70bf 3c31 3930
        0x0020:  3e4a 756e 2032 3820 3137 3a31 333a 3235
        0x0030:  2031 3932 2e31 3638 2e30 2e39 393a 2074
        0x0040:  6865 2070 6c61 6e65 7420 6973 2067 6f69
        0x0050:  6e67 2064 6f77 6e00

OpenVPN is an opensource Virtual Private Networking (VPN) solution which can be downloaded freely on the Internet. It also included in almost every Linux distro to-date, so it can be easily installed using your distro’s favourite package manager tools. It uses the SSL/TLS VPN stacks, which makes it different from almost every other VPN solution (which are usually based on IPSec).

This guide will described how OpenVPN can be installed and configured on a Debian system, so that it can be used as a means to connect to your home and company networks.

The Server

First install the openvpn package:

# apt-get install openvpn

If apt-get suggests extra packages to install, just install them!

Two networks will be created:
* one to create a secure network for servers: 192.168.1.0/24
* one to create a secure network of client PC’s, Macbooks, Linux desktops, … : 10.66.99.0/24

Next, we will need an OpenVPN configuration file for the OpenVPN we’re about to create:

.oO( ieyasu | /etc/openvpn )Oo. cat server.conf 
# LIKE A BOSS
local 176.9.64.17
port 1194
proto udp
dev tun0

mode server
tls-server

persist-key
persist-tun

#certificates and encryption
ca ca.crt
cert ieyasu.crt
key ieyasu.key
dh dh2048.pem
tls-auth ta.key 0
cipher AES-256-CBC
comp-lzo

server 192.168.1.0 255.255.255.0
route  10.66.99.0 255.255.255.0

ifconfig-pool-persist ipp.txt
push "route 10.66.99.0 255.255.255.0"

# separate client configs
client-config-dir ccd

#log and security
user nobody
group nogroup
keepalive 5 30
status /var/log/openvpn-status.log
verb 3

We will also need some firewall rules allowing our OpenVPN traffic:

$IPTABLES -A INPUT   -i tun0 -s 192.168.1.0/24 -d 192.168.1.0/24 -j ACCEPT
$IPTABLES -A INPUT   -i tun0 -s 10.66.99.0/24  -d 192.168.1.1    -j ACCEPT
$IPTABLES -A INPUT   -i tun0 -s 10.66.99.0/24  -d 10.66.99.0/24  -j ACCEPT

$IPTABLES -P FORWARD DROP
$IPTABLES -A FORWARD -i tun0 -s 10.66.99.0/24  -d 192.168.1.1    -j ACCEPT
$IPTABLES -A FORWARD -i tun0 -s 10.66.99.0/24  -d 10.66.99.0/24  -j ACCEPT
$IPTABLES -A FORWARD -i tun0 -s 192.168.1.0/24 -d 192.168.1.0/24 -j ACCEPT

$IPTABLES -A INPUT -p udp --dport 1194 -j ACCEPT

Now we need to create a CCD file for each client. The CCD file contains the network settings for the connection OpenVPN clients.
Example:

.oO( ieyasu | ~ )Oo. cat /etc/openvpn/ccd/bear
ifconfig-push 192.168.1.11 192.168.1.12
.oO( ieyasu | ~ )Oo. cat /etc/openvpn/ccd/lion
ifconfig-push 10.66.99.3 10.66.99.4

The final thing to do for the OpenVPN server, is to create the x509 certificates.

First:

# mkdir /etc/openvpn/easy-rsa/
# cp -R /usr/share/doc/openvpn/examples/easy-rsa/2.0/* /etc/openvpn/easy-rsa/

This will copy the required tools for creating the certificates for both the server as the clients.

Next, specify your information in /etc/openvpn/easy-rsa/vars, only the bottom is of real importance:

vi /etc/openvpn/easy-rsa/vars
*snip*
# These are the default values for fields
# which will be placed in the certificate.
# Don't leave any of these fields blank.
export KEY_COUNTRY="BE"
export KEY_PROVINCE="LIM"
export KEY_CITY="As"
export KEY_ORG="MORETRIX"
export KEY_EMAIL="info@moretrix.com"

Finally we will create the CA and the server certificate (we’re making a 2048 one!):

# cd /etc/openvpn/easy-rsa/
# chown -R root:admin .
# chmod g+w .
# source ./vars
# ./clean-all
# ./build-dh
# ./pkitool --initca
# ./pkitool --server server
# cd keys
# openvpn --genkey --secret ta.key
# cp server.crt server.key ca.crt dh2048.pem ta.key ../../

Finally we just need to start the OpenVPN service and the server is ready!

# /etc/init.d/openvpn restart

The Clients

Every client will need his own x509 certificate:

# cd /etc/openvpn/easy-rsa
# ./pkitool bear

bear is the name of the client host.

Now create a client configuration file, let’s call it bear.conf and we’ll save in it /tmp/client_config/:

client
dev tun
remote 176.9.64.17 1194
nobind
resolv-retry infinite
persist-key
persist-tun
ca ca.crt
cert bear.crt
key bear.key
tls-auth ta.key 1
cipher AES-256-CBC
comp-lzo
verb 3

Finally grab all the files the client will need

# cd /etc/openvpn/easy-rsa/keys/
# cp ca.crt ta.key bear.crt bear.key /tmp/client_config/
# cd /tmp/client_config/
# ls -ltr
total 24
-rw------- 1 root root  636 Jun 22 16:17 ta.key
-rw-r--r-- 1 root root 1537 Jun 22 16:17 ca.crt
-rw-r--r-- 1 root root 5053 Jun 22 16:17 bear.crt
-rw------- 1 root root 1704 Jun 22 16:17 bear.key
-rw-r--r-- 1 root root  185 Jun 22 16:17 bear.conf

If the client also uses the OpenVPN command line tools, just copy the above files to /etc/openvpn and restart the openvpn service.

root@bear:/etc/openvpn# ls -ltr
total 28
-rwxr-xr-x 1 root root 1357 2011-03-11 02:03 update-resolv-conf
-rw-r--r-- 1 root root  636 2011-06-20 22:40 ta.key
-rw-r--r-- 1 root root 1537 2011-06-20 22:40 ca.crt
-rw-r--r-- 1 root root 1704 2011-06-20 22:40 bear.key
-rw-r--r-- 1 root root 5053 2011-06-20 22:40 bear.crt
-rw-r--r-- 1 root root  185 2011-06-21 20:13 bear.conf
root@bear:/etc/openvpn# /etc/init.d/openvpn restart

Resources

* https://help.ubuntu.com/community/OpenVPN
* http://openvpn.net/index.php/open-source/documentation/howto.html
* http://openvpn.net/index.php/open-source/documentation/miscellaneous/76-ethernet-bridging.html

Nowadays, a lot of people have iPhone or like me, an Android phone. A descent Android phone contains a GPS device. A GPS device connected to a computer (or Android phone) could record your GPS positions during a certain period. Ok … that’s cool actually!
Because, when you’re shooting photos, you practically always have your mobile phone with you!

So, all we need now is a handy tool on your Android phone, which will record or track your GPS positions during a certian period. Behold ‘Open GPS Tracker‘. Open GPS Tracker is a tool which allows you to track your GPS positions and then afterwards, when you stop the program, you can export and share this information. The export is done using the GPX format, sharing is done through email.

Of course, any GPS device (plus software) which generates GPX files, will do just fine

This GPX file is nothing more than an XML file. And XML files are easy to parse in Perl using the XML::LibXML module.
We will also need to other CPAN modules, Date::Parse and Image::ExifTool. The first one is used to parse the date strings in the GPX XML file and the date strings in the EXIF information of the photo. The second module is used to read the EXIF information into a Perl hash.

use strict; use warnings;
use XML::LibXML;
use Image::ExifTool;
use Date::Parse;

use constant MAX_TIME_THRESHOLD => 10;

my ($gpx_file) = './Track201104180901.gpx';
my ($gpx_obj)  = XML::LibXML->new() ;
my $xml        = $gpx_obj->parse_file($gpx_file);
my $root       = $xml->getDocumentElement;

my $gps_db;
foreach my $pt ( $root->getElementsByTagName('trkpt') ) {
    my($lat)  = $pt->findvalue('@lat');
    my($lon)  = $pt->findvalue('@lon');
    my($alt)  = $pt->getElementsByTagName('ele')->[0]->textContent();
    my($time) = $pt->getElementsByTagName('time')->[0]->textContent();
    my $utime = str2time($time);

    $gps_db->{$utime} = {
        'time'   => $time,
        'lat'    => $lat,
        'lon'    => $lon,
        'alt'    => $alt,
    };
}

In this first part, we read in the XML file and store relevant information – like latitude, longitude and altitude – in a hash.

When the hash is ready, we can start scanning some photos.

my @images = (qw/jmp151.jpg jmp152.jpg jmp154.jpg/);
foreach my $img (@images) {
    my $exif = Image::ExifTool->new();
    my $info = $exif->ImageInfo($img);
    if(not defined $info->{GPSLatitude} and not defined $info->{GPSLongitude}){
        next unless $info->{DateTimeOriginal};
        my $data = get_gps_fix($info->{DateTimeOriginal});
        
        next unless defined $data and keys %{$data};

        $exif->SetNewValue('GPSLatitude',  $data->{lat});
        $exif->SetNewValue('GPSLongitude', $data->{lon});
        $exif->SetNewValue('GPSAltitude',  $data->{alt});

        if( $exif->WriteInfo($img) ){
            print "Image [$img] EXIF info has been successfully updatedn";
        }
    }
}

sub get_gps_fix {
    my($time) = @_;
    $time =~ s/ /T/;
    $time =~ s/$/Z/;
    my $utime = str2time($time);

    for(my $count=0; $count < MAX_TIME_THRESHOLD; $count++) {
        my $index = $utime - $count;
        if(exists $gps_db->{"$index"}){
            return $gps_db->{"$index"}
        }
    }
}

I’m using a constant called MAX_TIME_THRESHOLD, because it may happen that at a certian timestamp, no GPS position was recorded or available. The threshold I use goes back maximum 10 seconds before giving up. Moreover, if the logging density has been set to Fine, Open GPS Tracker should record also every second a GPS position.

One thing you don’t have to do with those online services like Flickr etc. is generating smaller sizes of your photos, also called thumbnails. But if you maintain your own website, you will have to downsize them on your own.
Being a programmer, I’m the happiest when I’m the laziest. So, in case of websites and photos, I don’t want to create the zillion of thumbnails that I need on my page.
Zillion? Isn’t that a little bit exajurated? Well, mostly you will need more than one thumbnail for every picture you will upload:
– one thumbnail is needed for on the thumbnail page
– one smaller thumbnail is needed for a small thumbnail preview bar
– one even smaller thumbnail is needed for marking the photo on a Google Map
– one smaller sized photo is needed for previewing it on the website
– and finally the original image is also put available for download on the site

We’ll need at least 4 extra images for every photo. Okay, I could generate all those thumbs at home and then upload them all together, but that is wasting bandwidth and time and we know how precious they both are.

Being a programmer in my professional life, I have the deviation to automate everything I know or do, with a Perl script. And this situation is again perfect for such a script.

First of all, the following code will make heavy use of the Image::Magick Perl module, which can be downloaded from either CPAN or your distro’s repositry.

The several steps of manipulating the original image, were actually inspired by the following two links:
– http://www.imagemagick.org/Usage/thumbnails/#glass_bubble
– http://stackoverflow.com/questions/3973392/facebook-like-resizing-of-images-using-imagemagick

The second link explains how to resize and crop, the first link explains how create neat thumbnails using rounded corners, lighting effects and more. Now, both links give examples using the command line Image Magick tools. I’ve seen a lot of code which will call these command line tools instead of using the Image::Magick module. That is of course, NOT the way.

On with creating our thumbnails! First, the image needs to be resized:

my $img = 'image.png';
my $magick = new Image::Magick;
$magick->Read($img);
my ($width, $height) = $magick->Get('width', 'height');

$magick->Resize(geometry => int($width/2).'x'.int($height/2));
$magick->Resize(geometry => '180x');
$magick->Resize(geometry => 'x180<');
   
my($nwidth, $nheight) = $magick->Get('width', 'height');
my $xpos = int(( $nwidth - 120 ) / 2) - 60;
my $ypos = int(( $nheight - 120 ) / 2) - 60;
$magick->Crop(geometry => "120x120+$xpos+$ypos", gravity => 'Center');

The above code will generate a thumbnail which are 120px by 120px big (or small), using a cropped field out of the 180px by 180px scaled image. The position of the cropped field is somewhat in the middle of the image, where usually the object of the photo can be found.

Next we’ll add some effects to our downsized image. We’ll do this by cloning the resized Image Magick object, that was created in the code above:

my $thumb_mask = $magick->Clone();

Once the object has been cloned, we can start by adding effects to the new object:

$thumb_mask->Set('alpha' => 'Off');
$thumb_mask->Colorize( fill => 'white', opacity => '100%' );

$thumb_mask->Draw( fill => 'black',
                   primitive => 'polygon',
                   points => '0,0 0,15 15,0');
$thumb_mask->Draw( fill => 'white',
                       primitive => 'circle',
                       points => '15,15 15,0');
my $new_2 = $thumb_mask->Clone();
$new_2->Flip();
$thumb_mask->Composite( compose => 'Multiply', 'image' => $new_2 );

my $new_3 = $thumb_mask->Clone();
$new_3->Flop();
$thumb_mask->Composite( compose => 'Multiply', 'image' => $new_3 );

$thumb_mask->Set('background' => 'Gray50');
$thumb_mask->Set('alpha' => 'Shape');

$thumb_mask->Raise(raise => 'True', geometry => '4x4');

By now we should have a rounded gray icon, based on the size of the thumbnail we’ve created above.

Next we will create some lighting and shading effects so that the thumbnail will look more like a button.

my $thumb_lighting = $thumb_mask->Clone();
$thumb_lighting->Set('bordercolor' => 'None');
$thumb_lighting->Set('border'      => '1x1');
$thumb_lighting->Set('alpha'       => 'Extract');
$thumb_lighting->Blur('geometry'       => '0x10');
$thumb_lighting->Shade(geometry => '80x40');
$thumb_lighting->Set('alpha'       => 'On');
$thumb_lighting->Set('background'  => 'Gray50');
$thumb_lighting->Set('alpha'       => 'Background');
$thumb_lighting->AutoLevel(channel => 'alpha');
$thumb_lighting->[-1]->Function(function => 'polynomial', parameters => [3.5, -5.05, 2.05, 0.3]);

my $new_4 = $thumb_lighting->Clone();
$new_4->Set(alpha => 'Extract');
$new_4->Blur(geometry => '0x2');

$thumb_lighting->Composite(compose => 'Multiply', image => $new_4);
$thumb_lighting->Chop(geometry => '1x1');

Finally, all that rests is putting all the images togehter and saving the file to disk:

$magick->Set('alpha' => 'On');
$magick->Composite(compose => 'HardLight', image => $thumb_lighting);
$magick->Set('alpha' => 'Copy');
$magick->Composite(compose => 'CopyOpacity', image => $thumb_mask);
$magick->Write('thumbnail.png');

Important to know is, since creating rounded corner will add some transparency to the original image, the newly created thumbnail must be save as either a GIF or PNG image, while those are the only two image formats which support transparency in images.

After the browsing the Internet a little bit, I have found this solution:

1. Exit Mail.app
2. In Terminal.app enter the command:

defaults delete com.apple.mail TableColumns

3. Start Mail.app

Now you should see the Subject column again, although it is still missing from View -> Columns.

You could of course also install the updated version of WideMail…

I’m going to use to beef up my image browser which I quickly wrote to simply the contents of directory full with images. (can be found overhere http://yamamoto.moretrix.com/~insaniac/grtp/

Here’s the link to the article.

Of course, most people don’t want to wait on a group of other people to update a piece of software.

I wrote this script to make my life a little bit easier, but it contains no rocket science. I’ve written it in Perl but it could have been just as easily written in Bash. But Perl is much cooler than Bash, and being cool is all that matters!

The script actually uses some command line tools, that should be installed. apt-cache and egrep are installed by default on Debian(-based) systems, dh-make-perl must be installed separately.

apt-get install dh-make-perl

Once dh-make-perl is installed, check out the man page for its options and arguments.

What are the steps required in the script:

• get a list of Perl packages
• filter out packages installed by dh-make-perl
• check if we really need to upgrade
• create new packages out of the CPAN versions
• optionally display the required packages

Packages created by dh-make-perl can be filtered out based on the package description. dh-make-perl adds ‘…automagically extracted from the module by dh-make-perl‘ to the package description when creating a Debian package.

It is possible that the package building of the CPAN module fails because the required modules or packages are missing. This information will be displayed when the scripts finishes. You will have to install this missing requirements and relaunch the script afterwards.

When build the Debian with dh-make-perl, the option ‘–recursive‘ will be used. This will also create Debian packages of required modules defined by the CPAN module.

When all these packages have been created, installed them with the dpkg command:

# dpkg -i $(ls -rt *.dpkg)

I’ve used the $(ls -rt *.dpkg) syntax because the packages will be in the order like they have been built.

The script:

#!/usr/bin/perl
# $Author: insaniac $
# $Id: upgrade_cpan_pkgs.pl 24 2011-03-10 13:54:32Z insaniac $
use strict; use warnings;
use Cwd;
use CPAN;

my $cwd = getcwd;
my ($script) = ($0 =~ /([^/]+)$/);
open my $LOG, '>', "$cwd/${script}_log" or die "KAK for [$cwd/$0_log]: $!n";

my %needed_pkgs;
foreach my $pkg (`apt-cache pkgnames | egrep '\-perl$'`){
    chomp($pkg);
    my $info = `apt-cache show $pkg`;
    if($info =~ m/automagically extracted from the module by dh-make-perl/ms){
        my ($cpan_pkg) = ( $pkg =~ m/^lib(.*?)-perl$/);
        $cpan_pkg =~ s/[_-]/::/g;
        my ($installed_version) = ( $info =~ m/Version:s+(.*?)-[0-9.]+$/m );
        my ($cpan_version) = CPAN::Shell->expand('Module', "/$cpan_pkg/");
        
        next unless ref $cpan_version;
        $cpan_version = $cpan_version->cpan_version;

        if($installed_version eq $cpan_version){
            print "- Package $cpan_pkg does not require updating (current version: $installed_version| CPAN version: $cpan_version)n";
            next;
        }


        print "- Building $cpan_pkg (outdated! installed version: $installed_version|CPAN version: $cpan_version)n";
        print $LOG "- Building $cpan_pkg (outdated! installed version: $installed_version|CPAN version: $cpan_version)n";
        print $LOG "="x80, "n";
        
        my $pkg_upgrade_info = `dh-make-perl --recursive --build --cpan $cpan_pkg`;
        print $LOG $pkg_upgrade_info;

        my ($need_deb_pkgs) = ($pkg_upgrade_info =~ m/Needs the following debian packages:s+(.*)$/ms);
        my ($need_build_deb_pkgs) = ($pkg_upgrade_info =~ m/Needs the following debian packages during building:s+(.*)$/ms);
        print $LOG "need_deb_pkgs: $need_deb_pkgsn"                if $need_deb_pkgs;
        print $LOG "need_build_deb_pkgs: $need_build_deb_pkgsn"    if $need_build_deb_pkgs;

        map { defined $_ && $needed_pkgs{$_}++ } split( /s*,s*/, $need_deb_pkgs )       if defined $need_deb_pkgs;
        map { defined $_ && $needed_pkgs{$_}++ } split( /s*,s*/, $need_build_deb_pkgs ) if defined $need_build_deb_pkgs;

        print $LOG "="x80, "n";
    }
}

print "Needed packages:n";
print "- $_: $needed_pkgs{$_} timesn" foreach keys %needed_pkgs;
print "n";
close $LOG;

Some output produced by the script:

$ perl ~/cheese_code/trunk/upgrade_cpan_pkgs.pl 2>&1|tee upgrade.log
CPAN: Storable loaded ok (v2.20)
Going to read '/home/insaniac/.cpan/Metadata'
  Database was generated on Sat, 05 Mar 2011 22:27:24 GMT
- Package geo::ip::pureperl does not require updating (current version: 1.25| CPAN version: 1.25)
- Package html::fromansi does not require updating (current version: 2.03| CPAN version: 2.03)
- Package net::google::calendar does not require updating (current version: 1.0| CPAN version: 1.0)
- Building poe::component::server::httpserver (outdated! installed version: 0.9.2|CPAN version: 0.009002)
Using cached Contents from Thu Mar 10 14:38:42 2011
**********
WARNING: a package named
              'libpoe-component-server-httpserver-perl'
         is already available in APT repositories
Maintainer: Johnny Morano 
Description: serve HTTP requests
- Package poe::filter::log::iptables does not require updating (current version: 0.02| CPAN version: 0.02)
- Package uri::imaps does not require updating (current version: 1.01| CPAN version: 1.01)
- Building class::accessor::chained (outdated! installed version: 0.01.1~debian|CPAN version: 0.01)
Using cached Contents from Thu Mar 10 14:38:42 2011
**********
WARNING: a package named
              'libclass-accessor-chained-perl'
         is already available in APT repositories
Maintainer: James Bromberger 
Description: make chained accessors
- Package www::google::contacts does not require updating (current version: 0.28| CPAN version: 0.28)

When working in a UNIX/Linux/MacOSX environment, the command is often used to execute some tasks. The default shell in the Terminal.app (MacOSX) and in most other terminals, is the Bourne Again Shell aka bash.

Bash is intended to be a conformant implementation of the Shell and Utilities portion of the IEEE POSIX specification. Bash also incorporates useful features from the Korn and C shells (ksh and csh).

Screen is a full-screen text-based window manager with VT100/ANSI terminal emulation. It has the ability to detach shell sessions, which is extremely useful for executing remote processes or executing processes that should be terminated after log out or termination of the shell process itself.

my ~/.bashrc

First we start off with configuration the Bash configuration file, which is located at ~/.bashrc for the current user or at /etc/bashrc.bashrc for system-wide configurations.

Most users will just edit their own bashrc file.
The options defined in this file, have comments above them so I won’t re-explain them.

# define your local timezone
export TZ='Europe/Brussels'

# If not running interactively, don't do anything
[ -z "$PS1" ] && return

# don't put duplicate lines in the history. See bash(1) for more options
export HISTCONTROL=ignoredups
# ... and ignore same sucessive entries.
export HISTCONTROL=ignoreboth

# check the window size after each command and, if necessary,
# update the values of LINES and COLUMNS.
shopt -s checkwinsize

# make less more friendly for non-text input files, see lesspipe(1)
[ -x /usr/bin/lesspipe ] && eval "$(SHELL=/bin/sh lesspipe)"

# set variable identifying the chroot you work in (used in the prompt below)
if [ -z "$debian_chroot" ] && [ -r /etc/debian_chroot ]; then
    debian_chroot=$(cat /etc/debian_chroot)
fi

# define all aliases in a separate file
if [ -f ~/.bash_aliases ]; then
    . ~/.bash_aliases
fi

# turn on bash completion, must be installed separately
if [ -f /etc/bash_completion ]; then
    . /etc/bash_completion
fi

# define some colors which will be used in PS1 and PS2
BLUE="[�33[0;34m]"
LIGHT_GRAY="[�33[0;37m]"
GREEN="[�33[0;32m]"
LIGHT_BLUE="[�33[1;34m]"
LIGHT_CYAN="[�33[1;36m]"
YELLOW="[�33[1;33m]"
WHITE="[�33[1;37m]"
RED="[�33[0;31m]"
NO_COLOUR="[�33[0m]"

# if this shell was started in the screen command, use a different PS1 prompt
if [[ $TERM =~ screen ]] ; then
    PS1="${GREEN}.oO( $BLUEh $GREEN|$BLUE w $GREEN)Oo"'[�33k][�33\]'".$NO_COLOUR "
else
    PS1="${GREEN}.oO( $BLUEh $GREEN|$BLUE w $GREEN)Oo.$NO_COLOUR "
fi
PS2="$GREEN.oO($NO_COLOUR "

This local bashrc file enables some default settings and creates a fancy bash prompt in colour. (See screenshot)

Next we’ll set up the Screen configuration file.

my ~/.screenrc

The following Screen configuration file sets some options that I find useful. These options included:

• no splash screen at startup
• no visual bell
• a customized status bar at the bottom of the screen
• a huge scrollback buffer
• updated window names, based on the current command
• UTF8 encoding

The file will be saved in the user home directory, at ~/.screenrc

# some default settings
startup_message off
vbell off
msgwait 1
defutf8 on
compacthist on

# Monitor windows
defmonitor on
activity ""

# Turns off alternate screen switching in xterms,
# so that text in screen will go into the xterm's scrollback buffer:
termcapinfo xterm* ti@:te@
altscreen on

# Enable 256 color terminal
attrcolor b ".I"
termcapinfo xterm 'Co#256:AB=E[48;5;%dm:AF=E[38;5;%dm'
defbce "on"

# Log 10000 lines
defscrollback 50000

backtick 2 60 60 echo $USERNAME

screen 0

shelltitle '. |bash'
hardstatus alwayslastline '%{= .y}.oO(%{= .b}%2`@%H%{= .y})Oo. %{= .b}%{+} %= %-w %{= .yb} %n:[%t] %{= db} %+w %{= .y}time: [%c]'

bindkey -k k2 screen                                    # F2  | Create new window
bindkey -k k3 prev                                      # F3  | Previous Window
bindkey -k k4 next                                      # F4  | Next Window
register r "^a:source $HOME/.screenrc^M"                #     | Goes with F5 definition
bindkey -k k5 process r                                 # F5  | Reload profile
bindkey -k k6 detach                                    # F6  | Detach from this session
bindkey -k k7 copy                                      # F7  | Enter copy/scrollback mode
register t "^aA^aa^k^h"                                 #     | Goes with the F8 definition
bindkey -k k8 process t                                 # F8  | Re-title a window

In order to have updated window names, it is important that the above Bash configuration regarding the PS1 variable, has been enabled. If not, then there will be no updated window names!

This configuration file was used to create the following screenshot:

References

Some options were taken out of the Byobu configuration file, others were found on the Interweb.

In some cases it is actually required to create a two way communication with the file handler, for instance when creating a pipe. In a pipe, some information is written to the pipe (left side of the pipe) which is read and analyzed by the right side of the pipe. This right of the pipe, is then able to produce some output.
If it is required to catch that output, we will need to have two file handlers!

A core module called IPC::Open2 provides an open2 subroutine, which allows to create a read and write file handler.

In the following example, we will mimic the shell command cat file|file -rik -, without calling the cat command. Instead we will open the file in RAW mode using Perl and then use file handlers to feed it to the file command and afterwards read the output.

#!/usr/bin/perl
use strict; use warnings;
use IPC::Open2;

my @files = (qw{
        parse_svn_log.zip scan_new.xsd bla.pl
        ../../root.tgz ../../bla.tar ../../Toyota.pdf
        ../../sms.bak scan.xml
        });

foreach my $file (@files) {
    print("Scanning $filen");
    open my $fh, '<:raw', $file or die "schijt: $!n";
    my $fc = <$fh>;
    close ($fh);
    my $mime = _get_mime_type($fc);

    print("- file: $file | mime: $mimen") if defined $mime;
}

sub _get_mime_type {
    my($data) = @_;
    my $mime = do { open2(my $read, my $write, 'file -rik -');
                    print {$write} $data."n"; 
                    close($write);
                    local $/;
                    <$read>; 
    }; 

    chomp($mime);
    if(defined $mime and $mime !~ m/^s*$/) {
        # 1) remove the '/dev/stdin:' part
        # 2) MIME type are always in the format: blabla/blabla
        # 3) in some rare cases their is a semicolon at the end
        #    e.g.: /dev/stdin: application/x-symlink; charset=binary
        $mime =~ s/.*?://s;
        ($mime) = ($mime =~ /(S+?/S+)/s);
        $mime =~ s/;.*$//g;    
    }
    else {
        $mime   = 'text/plain';
    }
    return $mime;
}

Output produced by script:

Scanning parse_svn_log.zip
- file: parse_svn_log.zip | mime: application/zip
Scanning scan_new.xsd
- file: scan_new.xsd | mime: application/xml
Scanning bla.pl
- file: bla.pl | mime: text/x-perl
Scanning ../../root.tgz
- file: ../../root.tgz | mime: application/x-gzip
Scanning ../../bla.tar
schijt: No such file or directory

Nowadays writing programs for tasks concerning Web 2.0 alike websites, is rather simple and easy. The only thing you will have to do, is learn their API. These API are mostly XML based requests and replies.

Most programming languages then write wrapper classes that call and access those API’s, like was done in Perl.
Thanks to the following modules, which can be found on CPAN, I wrote a small script which loads my contacts on Facebook and then updates or creates my contacts in GMail.

The script will retrieve some contact information, like the birthday, email addresses, status messages, and website information from Facebook as well as the profile picture of the contact. Then it will search your GMail Contact list for the user and will update the contact if it is found. Non-existing contacts will be ignored.

The modules used in the script are:

use WWW::Facebook::API;
use WWW::Google::Contacts;
use HTTP::Request;
use LWP;

All these modules can be downloaded from CPAN.

You will need to create a Facebook application, or you can use the application I have added. Before you can use the Facebook API, your application needs to be registered and known to Facebook. If you are not sure how to create and register an application at Facebook, please use mine. (No worries, I won’t do evil stuff)

After the module have been called in the script, we need to initialize some variables:

my $TMP    = $ENV{HOME}.'/tmp';
my %MONTHS = (
        January => '01',      February => '02',     March     => '03',
        April   => '04',      May      => '05',     June      => '06',
        July    => '07',      August   => '08',     September => '09',
        October => '10',      November => '11',     December  => '12',
);

my $facebook_api      = 'dad7ea6af99ba4ee11d6007f0a27cc6a';
my $facebook_secret   = '19d45131916886ffdad8d0a6899d6794';
my $facebook_clientid = '141446449211973';
my $facebook_browser  = '/usr/bin/firefox';
my $gmail_user        = 'user@gmail.com';
my $gmail_password    = 'secret';

• $TMP = we need to save the profile pics from Facebook and GMail somewhere on disk
• %MONTHS = conversion table for updating birthdates on GMail
• $facebook_ variables = numbers you get when you register an application on Facebook
• $gmail_ variables = obviously you will need a GMail account to update your contacts

my $client = WWW::Facebook::API->new(
    desktop         => 1,
    api_version     => '1.0',
    api_key         => $facebook_api,
    secret          => $facebook_secret,
);
$client->app_id($facebook_clientid);

local $SIG{INT} = sub {
    print "Logging out of Facebookn";
    my $r = $client->auth->logout;
    exit(1);
};

my $token = $client->auth->login(browser => $facebook_browser);
$client->auth->get_session($token);

my $google = WWW::Google::Contacts->new( username => $gmail_user, password => $gmail_password );
my $http   = LWP::UserAgent->new();

In the above part a Facebook object is created and a Facebook session will be created. If this is the first run that the program runs, it will ask on a Facebook page in your browser, to allow this application. Once allowed, the Facebook page can be closed.

The script will then also create a GMail object and a LWP object. The LWP object is needed to download the profile picture from the Facebook friend page.

In the next part, the friends list will be downloaded from Facebook, binded with the fields of information we are searching for.

print "About to get friends from Facebook...n";
my $friends_info = $client->users->get_info(
        uids   => $client->friends->get, 
        fields => [ qw/name first_name last_name status pic_big birthday email website about_me/ ] 
);

foreach my $friend (@{$friends_info}){

Ok, now we are ready to start taking the information from Facebook and updating it in GMail. The next part is the full content of the foreach loop, that was started above.

    # search google contact
    print "Searching for $friend->{name}...n";
    my @contacts = $google->contacts->search({full_name => $friend->{name}});
    if(not scalar @contacts){
        print "- $friend->{name} not found in Gmail Contacts Listn";
        next;
    }

    my $contact = pop @contacts;
    next unless defined $contact;

    if( defined $friend->{birthday} and $friend->{birthday} ne ''){
        my ($month, $day, $year) = ($friend->{birthday} =~ /^(D+) (d+)(?:, (d+))/);
        if(defined $year and defined $month and defined $day){
            $day   = sprintf '%02d', $day;
            $contact->birthday("${year}-$MONTHS{$month}-$day");
        }
    }

    if( defined $friend->{about_me} and $friend->{about_me} ne ''){
        $contact->notes($friend->{about_me});
    }

    if( defined $friend->{website} and $friend->{website} ne ''){
        my $websites = $contact->website;
        $websites ||= [];
        $contact->website($friend->{website}, @$websites) 
                        unless grep /Q$friend->{website}E/, @$websites;
    }

    if( defined $friend->{email} and $friend->{email} ne ''){
        my $emails = $contact->email;
        $emails ||= [];
        $contact->email($friend->{email}, @$emails) 
                        unless grep /Q$friend->{email}E/, @$emails;
    }

    if( defined $friend->{status}->{message} and $friend->{status}->{message} ne ''){
        my $jots = $contact->jot;
        $jots ||= [];
        $contact->jot($friend->{status}->{message}, @$jots)
                        unless grep /Q$friend->{status}->{message}E/, @$jots;
    }

    eval {
        $contact->update();
        print "- Contact information updatedn";
    };
    print "- Updating ".$contact->full_name." failed: $@n" if $@;

    # First update the contact information and then update the profile photo
    if( defined $friend->{pic_big} and $friend->{pic_big} ne ''){
        my $req = HTTP::Request->new('GET', $friend->{pic_big});
        my $file = $http->request($req);

        if($file->is_success){
            my $fpic = $TMP.'/fpic'.$friend->{uid}.'.jpg';
            my $gpic = $TMP.'/gpic'.$friend->{uid}.'.jpg';

            # save the Facebook profile pic to disk
            open my $fh, '>', $fpic or die "ERROR: $!n";
            print $fh $file->decoded_content;
            close $fh;

            # create a backup of the existing profile pic and then
            # delete it from Gmail Contacts
            if ( $contact->photo->exists ) {
                eval {
                    $contact->photo->to_file($gpic);
                };
                print "- Save of GMail profile pic failed: $@n" if $@;
            }

            # if a Facebook profile pic was downloaded, now upload it to 
            # Gmail Contacts
            if ( -f $fpic ) {
                eval {
                    $contact->photo->from_file($fpic);
                    $contact->photo->update;
                    print "- Profile pic ".$contact->full_name." updatedn";
                };
                print "- Failed to update profile pic: $@n" if $@;
            }
        }
        else {
            print "Failed to download profile picture of ". $friend->{name} ."n";
        }
    }

Set Permissions on Facebook:
The Facebook application needs more permissions than the basic permissions which are granted the first time you use the application. Copy paste the following URL into browser and you will presented a Facebook to allow or disallow the extended permissions for this application:

http://www.facebook.com/dialog/oauth?client_id=141446449211973&redirect_uri=https://jmorano.moretrix.com&scope=email,read_stream,user_birthday,friends_birthday,user_website,friends_website,export_stream,friends_online_presence,friends_status,sms,user_status,friends_about_me,friends_hometown,friends_location,publish_stream,read_stream,status_update

References:

• http://developers.facebook.com/docs/reference/api/user/
• http://developers.facebook.com/docs/authentication/
• http://search.cpan.org/~merixzon/WWW-Google-Contacts-0.28/lib/WWW/Google/Contacts.pm
• http://search.cpan.org/~unobe/WWW-Facebook-API-0.4.18/lib/WWW/Facebook/API.pm