#!@@HOMEBREW_PERL@@

# cliPSafe is a command line interface to Password Safe databases.
# Copyright (C) 2008  Ross Palmer Mohn, rpmohn@waxandwane.org
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.

# All code between the two lines "#=#=#=# Crypt::Pwsafe #=#=#=#" is taken from
# Crypt::Pwsafe v1.2 with some modification by Ross Palmer Mohn.

# All code between the two lines "#=#=#=# Term::Complete #=#=#=#" is taken from
# Term::Complete v1.402 with some modification by Ross Palmer Mohn so that it
# works only on the last word being entered.

use warnings;
use strict;

use FileHandle;
use Term::Cap;
use POSIX qw(:termios_h);

## Norm, Bold, and Underline functions
my $termios = new POSIX::Termios;
$termios->getattr;
my $ospeed = $termios->getospeed;
my $t = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };
my ($norm, $bold, $under) = map { $t->Tputs($_,1) } qw/me md us/;

## echo_off, and echo_on functions
my $fh_stdin = fileno(STDIN);
$termios->getattr($fh_stdin);
my $flags = $termios->getlflag();

sub echo_off {
    $termios->setlflag($flags & ~&POSIX::ECHO);
    $termios->setattr($fh_stdin, TCSANOW);
}

sub echo_on {
    $termios->setlflag(&POSIX::ECHO);
    $termios->setattr($fh_stdin, TCSANOW);
}

#=#=#=# Crypt::Pwsafe #=#=#=#
# Crypt::Pwsafe - Perl extension for decrypting and parsing PasswordSafe V3 data files

# Copyright 2006 Shufeng Tan, all rights reserved.
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.

# pwsafe3 file header format
# V3TAG == "PWS3";
# SALT = 32 bytes random
# NumHashIters = 32 bit integer (little endian)
# Hash = 32 bytes (NumHashIters+1 rounds of SHA256 of Safe combination concatenated with SALT)
# B1B2 = mKey encrypted using ECB Twofish with PTag as key
# B3B4 = hmac SHA256 key encrypted using ECB Twofish with PTag as key
# CBC IV = random 16 bytes

# Notes on records
# 1. All times are 32-bit little-endian integers
# 2. All field values except UUID and times use UTF8
# 3. SHA256 HMAC at the end of file is calculated on field values only

# Crypt::Pwsafe module provide read-only access to database files created by Version 3
# of PasswordSafe utility available from SourceForge at L<http://passwordsafe.sf.net>.
#
# Users of this module should take these notes:
#
# 1. All passwords will be stored in memory unencrypted (in the form of Perl hashes) once
# the password file is loaded.
#
# 2. The module will read the entire content of the password file into memory.  This may
# be a problem for large data files on systems with small amount of memory.
#
# 3. The modules does not support Version 2 Passwordsafe data files.  Please convert
# them to Version 3 if needed.

my $SHA = "Digest::SHA";
eval "use $SHA";
if ($@) { $SHA .= "::PurePerl"; eval "use $SHA" }

my $CIPHER = "Crypt::Twofish";
eval "use $CIPHER";
if ($@) { $CIPHER .= "_PP"; eval "use $CIPHER" }

my $DEBUG = 0;

my %FieldType = (
	0 => "None",
	1 => "UUID",
	2 => "Group",
	3 => "Title",
	4 => "User",
	5 => "Notes",
	6 => "Password",
	7 => "CTime",
	8 => "PWMTime",
	9 => "ATime",
	10 => "LifeTime",
	11 => "Policy",
	12 => "RecordMTime",
	13 => "URL",
	14 => "AutoType",
	15 => "PWHistory",
	255 => "EndofEntry"
);

sub open_safe {
	my ($file, $pw) = @_;
	my $fh = new FileHandle $file;
	die "Failed to open $file\n" unless defined $fh;
	$pw = enter_combination() unless defined $pw;
	my $header;
	my $len = 72;
	unless ($fh->read($header, $len) == $len) {
		die "$file has < $len bytes.\n";
	}
	$header =~ /^PWS3/ or warn "$file is not a version 3 Password Safe data file.\n";
	my $salt = substr($header, 4, 32);
	my $n_iters = unpack('V', substr($header, 36, 4));
	warn "$file uses < 2048 iterations of hash.\n" if $n_iters < 2048;
	warn "$file uses $n_iters iterations of hash?\n" if $n_iters > 20480;
	my $fhash = substr($header, 40, 32);
	my $ptag = _stretch_key($salt, $n_iters, $fhash, $pw);
	die "Bad safe combination.\n" unless $ptag;
	my $crypt = "";
	# Assume that the whole PWsafe file can comfortably fit into the memory
	while ($fh->read(my $buf, 0x400000)) {
		$crypt .= $buf;
	}
	$fh->close;
	my $self = _decrypt($ptag, $crypt);
	return bless($self);
}

sub _decrypt {
	my ($ptag, $crypt) = @_;
	my $len = length($crypt);
	die "Data is too short: $len bytes\n" unless $len > 112;
	die "Data length is not multiple of 16\n" unless $len % 16 == 0;
	my $term_blk = substr($crypt, -48, 16);
	$term_blk eq 'PWS3-EOFPWS3-EOF' or warn "Bad terminal block\n";
	my $hmac_tail = substr($crypt, -32);
	my ($key, $hmac_key) = _ecb_twofish($ptag, $crypt, 64);
	return _cbc_twofish($key, substr($crypt, 64, -48), $hmac_key, $hmac_tail);
}

sub _ecb_twofish {
	my ($ptag, $crypt, $len) = @_;
	my $fish = $CIPHER =~ /Twofish_PP/ ?
		Crypt::Twofish_PP->new($ptag) : Crypt::Twofish->new($ptag);
	my $bs = $fish->blocksize;
	my $head = "";
	for (my $i = 0; $i < $len; $i += $bs) {
		$head .= $fish->decrypt(substr($crypt, $i, $bs));
	}
	return unpack("a32a32", $head);
}

sub _cbc_twofish {
	my ($key, $crypt, $hmac_key, $hmac_tail) = @_;
	my $fish = $CIPHER =~ /Twofish_PP/ ?
		Crypt::Twofish_PP->new($key) : Crypt::Twofish->new($key);
	my $bs = $fish->blocksize;
	my $prev_crypt = substr($crypt, 0, $bs);
	my $ptr = $bs;
	my $chain_blocks = sub {
		my $curr_crypt = substr($crypt, $ptr, $bs);
		$ptr += $bs;
		my $curr_plain = $fish->decrypt($curr_crypt) ^ $prev_crypt;
		$prev_crypt = $curr_crypt;
		return $curr_plain;
	};
	my $plain = "";
	my $pwsafe = {};
	my $crypt_len = length($crypt);
	my ($group, $title);
	my $entry = {};
	while($ptr < $crypt_len) {
		my $curr_plain = $chain_blocks->();
		# Passwordsafe uses little-endian
		my ($len, $type) = unpack("VC", $curr_plain);
		#printf "len=%2d type=%3d ", $len, $type;
		die "Read negative length from CBC\n" if $len < 0;
		my $buf_len = $len > 11 ? 11 : $len;
		my $buf = substr($curr_plain, 5, $buf_len);
		$len -= $buf_len;
		while($len > 0) {
			my $curr_plain = $chain_blocks->();
			if ($len >= $bs) {
				$buf .= $curr_plain;
				$len -= $bs;
			} else {
				$buf .= substr($curr_plain, 0, $len);
				$len = 0;
			}
		}
		$plain .= $buf;
		#print unpack("H*", $buf), "\n";
		if ($type == 1) { # UUID
			$entry->{UUID} = unpack("H*", $buf);
			print "\tUUID=$entry->{UUID}\n" if $DEBUG;
		} elsif ($type == 2) {    # Group
			$group = pack("U0C*", unpack("C*", $buf));
			print "Group=$group\n" if $DEBUG;
		} elsif ($type == 3) {    # Title
			$title = pack("U0C*", unpack("C*", $buf));
			print "  Title=$title\n" if $DEBUG;
		} elsif ($type == 0xff) { # End of Entry
			if (defined($group) and defined ($title)) {
				if (exists $pwsafe->{$group}) {
					$pwsafe->{$group}->{"$title"} = $entry;
				} else {
					$pwsafe->{$group} = {"$title" => $entry};
				}
			}
			($group, $title) = (undef, undef);
			$entry = {};
		} else {
			my $descr = $FieldType{$type};
			$descr = "Type$type" unless defined $descr;
			my $value;
			if ($descr=~/Time/) {
				$value = unpack("V", $buf);
			} else {
				$value = pack("U0C*", unpack("C*", $buf));
			}
			$entry->{$descr} = $value;
			print "\t$descr=$value\n" if $DEBUG;
		}
	}
	my $hmac = Digest::SHA::hmac_sha256($plain, $hmac_key);
	die "SHA256 HMAC error: data integrity has been compromised.\n" unless $hmac eq $hmac_tail;
	return $pwsafe;
}

sub _stretch_key {
	my ($salt, $n_iters, $fhash, $pw) = @_;
	my $sha = eval("new $SHA(256)");
	$sha->add("$pw$salt");
	my $key = $sha->digest;
	for(my $i = 0; $i < $n_iters; $i++) {
		$sha->add($key);
		$key = $sha->digest;
	}
	$sha->add($key);
	return $key if $sha->digest eq $fhash;
}

sub enter_combination {
    print "Enter password safe combination: ";

    echo_off();
    chomp(my $pass = <STDIN>);
    print "\n";
    echo_on();

    return $pass;
}

#=#=#=# Crypt::Pwsafe #=#=#=#

#=#=#=# Term::Complete #=#=#=#
# Term::Complete - Perl word completion module
# AUTHOR Wayne Thompson

my($complete, $kill, $erase1, $erase2, $tty_raw_noecho, $tty_restore, $stty, $tty_safe_restore);
my($tty_saved_state) = '';
CONFIG: {
    $complete = "\004";
    $kill     = "\025";
    $erase1 =   "\177";
    $erase2 =   "\010";
    foreach my $s (qw(/bin/stty /usr/bin/stty)) {
	if (-x $s) {
	    $tty_raw_noecho = "$s raw -echo";
	    $tty_restore    = "$s -raw echo";
	    $tty_safe_restore = $tty_restore;
	    $stty = $s;
	    last;
	}
    }
}

sub Complete {
    my($prompt, @cmp_lst, $cmp, $test, $l, @match);
    my ($return, $r) = ("", 0);

    $return = "";
    $r      = 0;

    $prompt = shift;
    if (ref $_[0] || $_[0] =~ /^\*/) {
	@cmp_lst = sort @{$_[0]};
    }
    else {
	@cmp_lst = sort(@_);
    }

    # Attempt to save the current stty state, to be restored later
    if (defined $stty && defined $tty_saved_state && $tty_saved_state eq '') {
	$tty_saved_state = qx($stty -g 2>/dev/null);
	if ($?) {
	    # stty -g not supported
	    $tty_saved_state = undef;
	}
	else {
	    $tty_saved_state =~ s/\s+$//g;
	    $tty_restore = qq($stty "$tty_saved_state" 2>/dev/null);
	}
    }
    system $tty_raw_noecho if defined $tty_raw_noecho;
    LOOP: {
        local $_;
        print($prompt, $return);
        while (($_ = getc(STDIN)) ne "\r") {
            CASE: {
                # (TAB) attempt completion
                $_ eq "\t" && do {
                    my ($base, $word);
                    if($return =~ m/(\S+\s+)(\S*)$/) {
                        $base = $1;
                        $word = $2;
                    } else {
                        $base = "";
                        $word = $return;
                    }
                    my $rw = length($word);
                    @match = grep(/^\Q$word/, @cmp_lst);
                    unless ($#match < 0) {
                        $l = length($test = shift(@match));
                        foreach $cmp (@match) {
                            until (substr($cmp, 0, $l) eq substr($test, 0, $l)) {
                                $l--;
                            }
                        }
                        print("\a");
                        print($test = substr($test, $rw, $l - $rw));
                        $rw = length($word .= $test);
                    }
                    $r = length($return = "$base$word");
                    last CASE;
                };

                # (^D) completion list
                $_ eq $complete && do {
                    my ($base, $word);
                    if($return =~ m/(\S+\s+)(\S*)$/) {
                        $base = $1;
                        $word = $2;
                    } else {
                        $base = "";
                        $word = $return;
                    }
                    print(join("\r\n", '', grep(/^\Q$word/, @cmp_lst)), "\r\n");
                    $return = "$base$word";
                    redo LOOP;
                };

                # (^U) kill
                $_ eq $kill && do {
                    if ($r) {
                        $r	= 0;
			$return	= "";
                        print("\r\n");
                        redo LOOP;
                    }
                    last CASE;
                };

                # (DEL) || (BS) erase
                ($_ eq $erase1 || $_ eq $erase2) && do {
                    if($r) {
                        print("\b \b");
                        chop($return);
                        $r--;
                    }
                    last CASE;
                };

                # printable char
                ord >= 32 && do {
                    $return .= $_;
                    $r++;
                    print;
                    last CASE;
                };
            }
        }
    }

    # system $tty_restore if defined $tty_restore;
    if (defined $tty_saved_state && defined $tty_restore && defined $tty_safe_restore)
    {
	system $tty_restore;
	if ($?) {
	    # tty_restore caused error
	    system $tty_safe_restore;
	}
    }
    print("\n");
    $return;
}
#=#=#=# Term::Complete #=#=#=#

#=#=#=# cliPSafe #=#=#=#
use DateTime;

sub getcmd {
    my $prompt = shift;

    print "$prompt";
    my $cmd = <STDIN>;
    chomp($cmd);

    return $cmd;
}

sub ls {
    my ($pwsafe, $pwd) = @_;

    if ($pwd eq "") {
        #if($#pwsafe > 0 || $pwsafe->){}
        print "${under}Groups:$norm\n";
        foreach my $x (sort keys %$pwsafe) {
            print "  $x\n" if $x ne "";
        }
    }

    my $h = $pwsafe->{$pwd};
    if (keys %$h) {
        print "${under}Entries:$norm\n";
        foreach my $x (sort keys %$h) {
            print "  $x\n";
        }
    }

    print "\n";
}

sub printfield {
    my ($e, $f, $ftxt) = @_;

    if (exists $e->{$f}) {
        my $txt = "$e->{$f}";

        $txt = DateTime->from_epoch(epoch => $txt) if $f =~ m/Time$/;

        print "$bold$ftxt$norm$txt\n" if $txt =~ m/./;
    }
}

sub printentry {
    my ($pwsafe, $pwd, $entry) = @_;

    print "$bold$under$pwd/$entry$norm\n";
    my $eh = $pwsafe->{$pwd}->{$entry};
    printfield ($eh, "User",        "User:      ");
    printfield ($eh, "Password",    "Password:  ");
    printfield ($eh, "AutoType",    "AutoType:  ");
    printfield ($eh, "URL",         "URL:       ");
    printfield ($eh, "LifeTime",    "LifeTime:  ");
    printfield ($eh, "Policy",      "Policy:    ");
    printfield ($eh, "PWHistory",   "PWHistory: ");
    printfield ($eh, "CTime",       "Created on:                ");
    printfield ($eh, "PWMTime",     "Password last changed on:  ");
    printfield ($eh, "ATime" ,      "Last accessed on:          ");
    printfield ($eh, "RecordMTime", "Any field last changed on: ");
    printfield ($eh, "Notes",       "Notes:\n");
    print "\n";
}

sub show {
    my ($pwsafe, $pwd, $entry, $flatlist) = @_;
    my ($g_matches, $e_matches);
    my $count = 0;

    if ($flatlist) {
        foreach my $group (sort keys %$pwsafe) {
            my $gh = $pwsafe->{$group};
            foreach my $e (sort keys %$gh) {
                if ($e =~ m/$entry/i) {
                    $count++;
                    $g_matches->{$count} = $group;
                    $e_matches->{$count} = $e;
                }
            }
        }
    } else {
        my $gh = $pwsafe->{$pwd};
        foreach my $e (sort keys %$gh) {
            if ($e =~ m/$entry/i) {
                $count++;
                $g_matches->{$count} = $pwd;
                $e_matches->{$count} = $e;
            }
        }
    }

    if ($count == 0) {
        print "No match for $entry\n\n";
        return;
    }

    my $num = 1;
    if ($count > 1) {
        foreach my $n (sort {$a <=> $b} keys %$g_matches) {
            print "$n - $g_matches->{$n}/$e_matches->{$n}\n";
        }
        $num = getcmd ("Choose (0 to cancel): ");
    }

    if ($num =~ m/^\s*\d+\s*$/ && $num <= $count && $num > 0) {
        printentry ($pwsafe, $g_matches->{$num}, $e_matches->{$num});
    }
}

sub cg {
    my ($pwsafe, $pwd, $entry) = @_;

    if ($entry =~ m/\/|\\/) {
        print "\n";
        return "";

    } elsif (exists $pwsafe->{$entry}) {
        print "\n";
        return $entry;

    } else {
        print "Group not found: $entry\n\n";
    }

    return $pwd;
}

sub printhelp {
    print "Valid commands are:\n";
    print "    ls [group]      - list groups & entries\n";
    print "    cg <group>      - change group (root = /)\n";
    print "    show [-l] <rxp> - show an entry, use -l to treat db as a flat list\n";
    print "    exit            - exit clipsafe\n\n";
    print "Commands ls and cg support tab completion on group names\n\n";
}

sub usage {
    print "cliPSafe version 1.0, Copyright (C) 2008 Ross Palmer Mohn\n";
    print "cliPSafe comes with ABSOLUTELY NO WARRANTY. This is free software,\n";
    print "and you are welcome to redistribute it under certain conditions.\n\n";

    print "Usage:\n";
    print "    clipsafe [-h] [-f dbfname] [rxp]\n\n";
}

sub getfname {
    my $fname = shift;
    my $pname = "$ENV{HOME}/.passwordsafe/preferences.properties";
    my %prefs;

    if ($fname eq "" && -f $pname) {
        open FILE, $pname;
        while (<FILE>) {
            my ($k, $v) = split (/=/);
            if (defined $v) {
                chomp ($v);
                $prefs{$k} = $v;
            }
        }
        close FILE;
        $fname = $prefs{"mru.1"} if exists $prefs{"mru.1"};
    }

    if ($fname eq "") {
        $fname = getcmd("Enter database file name: ");
    }

    die "File not found: $fname\n" unless $fname && -f $fname;

    print "${bold}File: $norm$fname\n";

    return $fname;
}

#-- main --#

my $rxp = "";
my $fname = "";

if ($#ARGV >= 0 && $ARGV[0] =~ m/-h/i) {
    usage();
    exit;
} elsif ($#ARGV == 0 && $ARGV[0] =~ m/-f/i) {
    print "Bad command line.\n";
    usage();
    exit;
} elsif ($#ARGV == 0) {
    $rxp = "$ARGV[0]";
} elsif ($#ARGV > 0 && $ARGV[0] =~ m/-f/i) {
    shift(@ARGV);
    $fname = shift(@ARGV);
    $rxp = join (" ", @ARGV);
} else {
    $rxp = join (" ", @ARGV);
}

my $file = getfname($fname);
my $comb = enter_combination();
my $pwsafe = open_safe($file, $comb);
my $pwd = "";
print "\n";

if ($rxp ne "") {
    show ($pwsafe, "", "$rxp", 1);
    exit;
}

while(1) {
    my @groups;
    foreach my $grp (sort keys %$pwsafe) {
        push (@groups, "$grp");
    }
    my $cmd = Complete ("${bold}cliPSafe:$pwd> $norm", @groups);

    if ($cmd =~ m/^\s*(exit|quit)\s*$/i) {
        exit;
    } elsif ($cmd =~ m/^\s*ls\s+(.+)\s*$/i) {
        ls ($pwsafe, $1);
    } elsif ($cmd =~ m/^\s*ls\s*$/i) {
        ls ($pwsafe, $pwd);
    } elsif ($cmd =~ m/^\s*c(g|d)\s+(.+)\s*$/i) {
        $pwd = cg ($pwsafe, $pwd, "$2");
    } elsif ($cmd =~ m/^\s*c(g|d)\s*$/i) {
        $pwd = cg ($pwsafe, "$pwd", "/");
    } elsif ($cmd =~ m/^\s*show\s+-l\s+(.+)\s*$/i) {
        show ($pwsafe, $pwd, "$1", 1);
    } elsif ($cmd =~ m/^\s*show\s+(.+)\s*$/i) {
        show ($pwsafe, $pwd, "$1", 0);
    } elsif ($cmd =~ m/^\s*help\s*$/i) {
        printhelp;
    } else {
        print "Bad command: $cmd\n\n";
        printhelp;
    }
}
#=#=#=# cliPSafe #=#=#=#

