#!/usr/bin/perl -w

# Dump GNU Keyring database entries to stdout
#
# original by Dobrica Pavlinusic <dpavlin@rot13.org> 2000-08-01
#
# revised by Fulko van Westrenen 2015-11-13
#    - standard output in keepass 1 XML format
#    - puts all in "Generic" group
#    - modification date added
#    - missing: UTF8 support
#    - some small errors corrected
#
# 2003-02-23 security update: read password only from terminal (no more
# 		passwords in shell history files), verify passwords
# 
# http://www.rot13.org/~dpavlin/
# http://gnukeyring.sourceforge.net/
#
# PDA::Pilot comes with source of pilot-link, others are from CPAN
#
# 

use strict;
use PDA::Pilot;
use Crypt::DES; 
use Digest::MD5 qw(md5);
use Getopt::Std;
use Term::ReadPassword;

my %opts;
#$opts{d} = $ENV{'HOME'}."/.jpilot/backup/Keys-Gtkr.pdb";
$opts{d} = $ENV{'HOME'}."/.jpilot/Keys-Gtkr.pdb";

if ((! getopts('d:h46',\%opts) && (! -f $opts{d} || -r $opts{d})) || $opts{h}) {
  print "Usage: $0 [-d dbname][-h][-4][-6]\n";
  print "Dump all records from your GNU keyring database protected\n";
  print "by password.\nOptions:\n";
  print "\t-4 produce 4-field ZSafe 1.x compatibile format\n\n";
  print "\t-6 produce 6-field ZSafe 2.x compatibile format\n\n";
  exit;
}

die "Can't open $opts{d}" if (! -f $opts{d} || ! -r $opts{d});
my $db = PDA::Pilot::File::open($opts{d});

my $passwd = read_password('GNU keyring password: ');

my $key = md5($passwd);
my $c1 = new Crypt::DES substr($key,0,8);
my $c2 = new Crypt::DES substr($key,8,8);

# check password
my $r = $db->getRecord(0);
my $msg = substr($r->{raw},0,4).$passwd."\000" x 64;
$msg = substr($msg,0,64);	# cut to 64 bytes
my $digest = md5($msg);
if (substr($r->{raw},4,length($digest)) ne $digest) {
  print "Wrong password!\n";
  exit 1;
}

print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<pwlist>\n";

my $i=1;
while(defined(my $r = $db->getRecord($i++))) {
  my ($name,$raw)=split(/\000/,$r->{raw},2);
  warn "record not 8 byte padded" if (length($raw) % 8) != 0;
  my $out="";
  for (my $j=0; $j<int(length($raw) / 8); $j++) {
    my $to=$c1->decrypt( substr($raw,$j*8,8) );
    my $other=$c2->encrypt($to);
    $to=$c1->decrypt($other);
    $out.=$to;
  }
  $name =~ s/\&/&amp;/g;
  $out =~ s/\&/&amp;/g;
  $out =~ s/\"/&quot;/g;
  $out =~ s/\'/&apos;/g;
  $out =~ s/</&lt;/g;
  $out =~ s/>/&gt;/g;

  my ($acc,$pass,$note,$packed_date)=split(/\000/,$out,4);
  $packed_date = substr($packed_date,0,2); #cut padding

  my $unpacked_date = unpack 'n', $packed_date;
  my $year = (($unpacked_date & 0xFE00) >> 9) + 4 + 1900;
  my $month = (($unpacked_date & 0x01E0) >> 5) ;
  my $day = ($unpacked_date & 0x001F);
  my $ymd = join '-', $year, $month, $day;
  
  if ($opts{4}) {
    $note =~ s/\n$//sg;	# kill extra lf
    $note =~ s/\n/<br>/sg;
    printf "\"palm\";\"$name\";\"$acc\";\"$pass\";\"$note\"\n";
  } elsif ($opts{6}) {
    $note =~ s/\n$//sg;	# kill extra lf
    $note =~ s/\n/<br>/sg;
    printf "\"palm\";\"$name\";\"$acc\";\"$pass\";\"$note\";\"\";\"\"\n";
  } else {
    print "<pwentry>\n";
    print "<group>General</group>\n";
    print "<title>$name</title>\n";
    print "<username>$acc</username>\n";
    print "<url></url>\n";
    print "<password>$pass</password>\n";
    print "<notes>$note</notes>\n";
    print "<image>0</image>\n";

    print "<creationtime>$ymd"."T00:00:00</creationtime>\n";
    print "<lastmodtime>$ymd"."T00:00:00</lastmodtime>\n";

    print "</pwentry>\n\n";
  }
}

print "</pwlist>\n"
