Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Update the kpcli script.

  • Loading branch information...
commit e76679ae66f1b3f7a2d40b6a0678a7c679ef770e 1 parent 5e094f3
Randy J. Ray authored
Showing with 391 additions and 45 deletions.
  1. +391 −45 dotfiles/bin/kpcli
436 dotfiles/bin/kpcli
View
@@ -1,4 +1,4 @@
-#!/usr/bin/perl
+#!/usr/bin/env perl
###########################################################################
#
@@ -16,10 +16,12 @@
###########################################################################
use strict; # core
+use Clone; # core
use FileHandle; # core
use Getopt::Long; # core
use File::Basename; # core
use Digest::file; # core
+use Digest::SHA qw(sha256); # core
use Data::Dumper qw(Dumper); # core
use Crypt::Rijndael; # non-core, libcrypt-rijndael-perl on Ubuntu
use Sort::Naturally; # non-core, libsort-naturally-perl on Ubuntu
@@ -31,11 +33,12 @@ $|=1;
my $DEBUG=0;
my $DEFAULT_ENTRY_ICON = 0; # In keepassx, icon 0 is a golden key
my $DEfAULT_GROUP_ICON = 49; # In keepassx, icon 49 is an opened file folder
+my $FOUND_DIR = '_found'; # The find command's results go in /_found/
my $APP_NAME = basename($0);
$APP_NAME =~ s/\.pl$//;
-my $VERSION = "1.0";
+my $VERSION = "1.4";
my $opts=MyGetOpts(); # Will only return with options we think we can use
@@ -56,7 +59,8 @@ my $term = new Term::ShellUI(
"help" => {
desc => "Print helpful information",
args => sub { shift->help_args(undef, @_); },
- method => sub { shift->help_call(undef, @_); }
+ method => sub { my_help_call(shift); }
+ #method => sub { shift->help_call(undef, @_); }
},
"h" => { alias => "help", exclude_from_completion=>1},
"?" => { alias => "help", exclude_from_completion=>1},
@@ -69,7 +73,7 @@ my $term = new Term::ShellUI(
"listed in preparation to run the show command.\n",
maxargs => 1,
args => \&complete_groups,
- method => sub { if(cli_cd(@_) == 0) { cli_ls(@_) } },
+ method => sub { if(cli_cd(@_) == 0) { cli_ls() } },
},
"cd" => {
desc => "Change directory (path to a group)",
@@ -83,15 +87,46 @@ my $term = new Term::ShellUI(
},
"chdir" => { alias => 'cd' },
"saveas" => {
- desc => "Save to a specific filename (saveas <file.kdb>)",
- minargs => 1, maxargs => 1,
- args => \&Term::ShellUI::complete_files,
+ desc => "Save to a specific filename " .
+ "(saveas <file.kdb> [<file.key>])",
+ minargs => 1, maxargs => 2,
+ args => [\&Term::ShellUI::complete_files,
+ \&Term::ShellUI::complete_files],
proc => \&cli_saveas,
},
+ "export" => {
+ desc => "Export entries to a new KeePass DB " .
+ "(export <file.kdb> [<file.key>])",
+ doc => "\n" .
+ "Use this command to export the full tree of groups\n" .
+ "and entries to another KeePass database file on disk,\n" .
+ "starting at your current path (pwd).\n" .
+ "\n" .
+ "This is also a \"safer\" way to change your database\n" .
+ "password. Export from /, verify that the new file is\n" .
+ "good, and then remove your original file.\n",
+ minargs => 1, maxargs => 2,
+ args => [\&Term::ShellUI::complete_files,
+ \&Term::ShellUI::complete_files],
+ proc => \&cli_export,
+ },
+ "import" => {
+ desc => "Import another KeePass DB " .
+ "(import <file.kdb> <path> [<file.key>])",
+ doc => "\n" .
+ "Use this command to import the entire KeePass DB\n" .
+ "specified by <file.kdb> into a new group at <path>.\n",
+ minargs => 2, maxargs => 3,
+ args => [\&Term::ShellUI::complete_files,\&complete_groups,
+ \&Term::ShellUI::complete_files],
+ proc => \&cli_import,
+ },
"open" => {
- desc => "Open a KeePass database file (open <file.kdb>)",
- minargs => 1, maxargs => 1,
- args => \&Term::ShellUI::complete_files,
+ desc => "Open a KeePass database file " .
+ "(open <file.kdb> [<file.key>])",
+ minargs => 1, maxargs => 2,
+ args => [\&Term::ShellUI::complete_files,
+ \&Term::ShellUI::complete_files],
proc => \&cli_open,
},
"mkdir" => {
@@ -171,7 +206,7 @@ my $term = new Term::ShellUI(
desc => "Finds entries by Title",
doc => "\n" .
"Searches for entries with the given search term\n" .
- "in their title and places matches into \"/_found/\".\n",
+ "in their title and places matches into \"/$FOUND_DIR/\".\n",
minargs => 1, maxargs => 1, args => "<search string>",
method => \&cli_find,
},
@@ -203,12 +238,12 @@ our $state={
};
# If given --kdb=, open that file
if (length($opts->{kdb})) {
- my $err = open_kdb($opts->{kdb}); # Sets $state->{'kdb'}
+ my $err = open_kdb($opts->{kdb}, $opts->{key}); # Sets $state->{'kdb'}
if (length($err)) {
print "Error opening file: $err\n";
}
} else {
- $state->{'kdb'} = File::KeePass->new;
+ new_kdb($state);
}
# Enter the interative kpcli shell session
@@ -237,8 +272,9 @@ exit;
############################################################################
############################################################################
-sub open_kdb($) {
+sub open_kdb($$) {
my $file=shift @_;
+ my $key_file=shift @_;
our $state;
# Make sure the file exists and is readable
@@ -271,7 +307,8 @@ sub open_kdb($) {
# Ask the user for the master password and then open the kdb
my $master_pass=GetMasterPasswd();
$state->{kdb} = File::KeePass->new;
- if (! eval { $state->{kdb}->load_db($file, $master_pass) }) {
+ if (! eval { $state->{kdb}->load_db($file,
+ composite_master_pass($master_pass, $key_file)) }) {
die "Couldn't load the file $file: $@";
}
@@ -280,7 +317,9 @@ sub open_kdb($) {
}
$state->{kdb_file} = $file;
+ $state->{key_file} = $key_file;
$state->{put_master_passwd}($master_pass);
+ $state->{kdb_has_changed}=0;
$master_pass="\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
# Build the %all_grp_paths_fwd and %all_grp_paths_rev structures
@@ -371,13 +410,13 @@ sub destroy_found {
our $state;
# Look for an exising /_found and kill it if it exists
my $k=$state->{kdb};
- my $found_group=$k->find_group({level=>0,title=>'_found'});
+ my $found_group=$k->find_group({level=>0,title=>$FOUND_DIR});
if (defined($found_group)) {
my @oldents = $k->find_entries({group=>$found_group->{id}});
foreach my $ent (@oldents) {
$k->delete_entry({id => $ent->{id}});
}
- $k->delete_group({level=>0,title=>'_found'});
+ $k->delete_group({level=>0,title=>$FOUND_DIR});
# Because we destroyed /_found we must refresh our $state paths
refresh_state_all_paths();
@@ -457,9 +496,9 @@ sub group_sort($$) {
my $b=shift @_;
# _found at level 0 is a special case (from our find command).
- if ($a->{title} eq '_found' && $a->{level} == 0) {
+ if ($a->{title} eq $FOUND_DIR && $a->{level} == 0) {
return 1;
- } elsif ($b->{title} eq '_found' && $b->{level} == 0) {
+ } elsif ($b->{title} eq $FOUND_DIR && $b->{level} == 0) {
return -1;
# Backup at level=0 is a special case (KeePassX's Backup group).
} elsif ($a->{title} eq 'Backup' && $a->{level} == 0) {
@@ -581,7 +620,7 @@ sub cli_find($) {
# Search entries by title, skipping the KeePassX /Backup group if it exists
my $search_params = { 'title =~' => $search_str };
- my $backup_dir_normalized=normalize_path_string("Backup"); # /Backup
+ my $backup_dir_normalized=normalize_path_string("/Backup"); # /Backup
if (defined($state->{all_grp_paths_fwd}->{$backup_dir_normalized})) {
$search_params->{'group_id !'} =
$state->{all_grp_paths_fwd}->{$backup_dir_normalized};
@@ -594,7 +633,7 @@ sub cli_find($) {
}
# If we get this far we have results to add to a new /_found
- my $found_group = $k->add_group({title => '_found'}); # root level group
+ my $found_group = $k->add_group({title => $FOUND_DIR}); # root level group
my $found_gid = $found_group->{'id'};
$k->unlock;
my @matches=();
@@ -607,7 +646,7 @@ sub cli_find($) {
# will not be saved to a file.
my $nulled_path=$state->{all_ent_paths_rev}->{$ent->{id}};
$new_ent{path} = '/' . dirname(humanize_path($nulled_path)) . '/';
- $new_ent{full_path} = humanize_path($nulled_path);
+ $new_ent{full_path} = '/' . humanize_path($nulled_path);
$k->add_entry(\%new_ent);
push(@matches, \%new_ent);
}
@@ -617,7 +656,7 @@ sub cli_find($) {
refresh_state_all_paths();
# Tell the user what we found
- print " - " . scalar(@matches) . " matches found and placed into /_found.\n";
+ print " - ".scalar(@matches)." matches found and placed into /$FOUND_DIR/\n";
# If we only found one, ask the user if they want to see it
if (scalar(@matches) == 1) {
@@ -625,7 +664,10 @@ sub cli_find($) {
my $key=get_single_key();
print "\n";
if (lc($key) eq 'y') {
- cli_show($self, { args => [ $matches[0]->{full_path} ] });
+ my $search_params = { 'group_id =' => $found_gid };
+ my ($e,@empty) = $k->find_entries($search_params);
+ my $full_path="/$FOUND_DIR/" . $e->{title};
+ cli_show($self, { args => [ $full_path ] });
}
}
}
@@ -647,13 +689,19 @@ sub scrub_unknown_values_from_all_groups {
our $state;
my $k=$state->{kdb};
my @all_groups_flattened = $k->find_groups({});
+ my @unkown_field_groups=();
foreach my $g (@all_groups_flattened) {
if (defined($g->{unknown})) {
- warn "Deleting unknown fields from group $g->{title}\n";
#warn "LHHD: " . &Dumper($g->{unknown}) . "\n";
delete $g->{unknown};
+ push @unkown_field_groups, $g->{title};
}
}
+ my $count = scalar(@unkown_field_groups);
+ if ($count > 0) {
+ warn "Deleted unknown fields from these $count groups: " .
+ join(", ", @unkown_field_groups) . "\n";
+ }
}
sub cli_save($) {
@@ -700,7 +748,8 @@ sub cli_save($) {
scrub_unknown_values_from_all_groups(); # TODO - remove later
my $k=$state->{kdb};
$k->unlock;
- my $master_pass=$state->{get_master_passwd}();
+ my $master_pass=
+ composite_master_pass($state->{get_master_passwd}(),$state->{key_file});
$k->save_db($state->{kdb_file},$master_pass);
$state->{kdb_has_changed}=0; # set our state to no change since last save
$master_pass="\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
@@ -894,7 +943,7 @@ sub cli_show($$) {
$state->{kdb}->unlock;
print "\n";
if (defined($ent->{path})) {
- show_format("Path",$ent->{path}) . "\n";
+ print show_format("Path",$ent->{path}) . "\n";
}
print
show_format("Title",$ent->{title}) . "\n" .
@@ -987,7 +1036,7 @@ sub get_entry_fields {
{ key=>'title', txt=>'Title' },
{ key=>'username', txt=>'Username' },
{ key=>'password', txt=>'Password',
- hide_entry => 1, double_entry_verify => 1 },
+ hide_entry => 1, double_entry_verify => 1, genpasswd => 1 },
{ key=>'url', txt=>'URL' },
{ key=>'comment', txt=>'Notes/Comments' },
);
@@ -1094,6 +1143,9 @@ sub cli_new($) {
my @fields = get_entry_fields();
foreach my $input (@fields) {
+ if ($input->{genpasswd}) {
+ print " "x25 . '("g" to generate a password)' . "\r";
+ }
print $input->{txt} . ": ";
if ($input->{hide_entry}) {
ReadMode(2); # Hide typing
@@ -1105,7 +1157,9 @@ sub cli_new($) {
if ($input->{key} eq 'title' && length($val) == 0) {
return;
}
- if ($input->{double_entry_verify}) {
+ if ($input->{genpasswd} && $val eq 'g') {
+ $val=generatePassword(20);
+ } elsif ($input->{double_entry_verify}) {
print "Retype to verify: ";
my $checkval = ReadLine(0);
if ($input->{hide_entry}) { print "\n"; }
@@ -1133,13 +1187,184 @@ sub cli_new($) {
return 0;
}
+sub cli_import($$) {
+ my $file=shift @_;
+ my $new_group=shift @_;
+ my $key_file=shift @_;
+ our $state;
+
+ # If the user gave us a bogus file there's nothing to do
+ if (! -f ($file)) {
+ print "File does not exist: $file\n";
+ return -1;
+ }
+ # If the $new_group path is relative, make it absolute
+ if ($new_group !~ m/^\//) {
+ $new_group = get_pwd() . "/$new_group";
+ }
+ # We won't import into an existing group
+ my $full_path=normalize_path_string($new_group);
+ if (defined($state->{all_grp_paths_fwd}->{$full_path})) {
+ print "You must specify a _new_ group to import into.\n";
+ return -1;
+ }
+ # Make sure the new group's parent exists
+ my ($grp_path,$grp_name)=normalize_and_split_raw_path($new_group);
+ if ($grp_path != '' && ! defined($state->{all_grp_paths_fwd}->{$grp_path})) {
+ print "Path does not exist: /" . humanize_path($grp_path) . "\n";
+ return -1;
+ }
+ # Set the $parent_group value appropriately
+ my $parent_group = undef; # Root by default
+ if (length($grp_path)) {
+ $parent_group = $state->{all_grp_paths_fwd}->{$grp_path};
+ }
+ # Ask the user for the master password and then open the kdb
+ my $master_pass=GetMasterPasswd();
+ my $iKDB = File::KeePass->new;
+ if (! eval { $iKDB->load_db($file,
+ composite_master_pass($master_pass, $key_file)) }) {
+ print "Couldn't load the file $file: $@\n";
+ return -1;
+ }
+ # Add the new group, to its parent or to root if $parent_group==undef
+ my $k=$state->{kdb};
+ my $new_group=$k->add_group({
+ title => $grp_name,
+ group => $parent_group,
+ });
+ # Copy the $iKDB into our $k at $new_group
+ $iKDB->unlock();
+ $k->unlock();
+ my @root_groups = $iKDB->find_groups({level=>0});
+ foreach my $i_root_grp (@root_groups) {
+ copy_kdb_group_tree($k,$i_root_grp,$new_group);
+ }
+ $k->lock();
+ $iKDB->lock();
+ $iKDB=undef;
+ # Refresh all paths and mark state as changed
+ refresh_state_all_paths();
+ $state->{kdb_has_changed}=1;
+ RequestSaveOnDBChange();
+}
+
+sub cli_export($$) {
+ my $file=shift @_;
+ my $key_file=shift @_;
+ our $state;
+
+ # Warn is we are being asked to overwrite a file
+ if (-e $file) {
+ print "WARNING: $file already exists.\n" .
+ "Overwrite it? [y/N] ";
+ my $key=get_single_key();
+ print "\n";
+ if (lc($key) ne 'y') {
+ return -1;
+ }
+ }
+
+ # Get the master password for the exported file
+ my $master_pass=GetMasterPasswd();
+ if (length($master_pass) == 0) {
+ print "For your safety, empty passwords are not allowed...\n";
+ return;
+ }
+ print "Retype to verify: ";
+ ReadMode('noecho');
+ my $checkval = ReadLine(0);
+ ReadMode('normal');
+ chomp $checkval;
+ print "\n";
+ if ($master_pass ne $checkval) {
+ print "Passwords did not match...\n";
+ return;
+ }
+
+ # Build the new kdb in RAM
+ my $k=$state->{kdb};
+ my $new_kdb=new File::KeePass;
+ $k->unlock; # Required so that we can copy the passwords
+ if (get_pwd() ne '/') {
+ # Grab the root group's $id at our pwd
+ my $pwd_group_id=$state->{path}->{id};
+ my ($root_grp,@trash) = $k->find_groups({id=>$pwd_group_id});
+ copy_kdb_group_tree($new_kdb,$root_grp,undef);
+ } else {
+ # Put all of the root groups into the new file (entire file copy)
+ my @root_groups = $k->find_groups({level=>0});
+ foreach my $root_grp (@root_groups) {
+ copy_kdb_group_tree($new_kdb,$root_grp,undef);
+ }
+ }
+ $k->lock;
+ $new_kdb->unlock;
+ my $new_db_bin =
+ $new_kdb->gen_db(composite_master_pass($master_pass,$key_file));
+ $new_kdb->lock;
+
+ # Test parsing the kdb from RAM (we'll most likely die if this fails)
+ my $new_db=new File::KeePass;
+ $new_db->parse_db($new_db_bin,composite_master_pass($master_pass,$key_file));
+
+ # Now write the new kdb to disk
+ my $fh=new FileHandle;
+ if (open($fh,'>',$file)) {
+ print $fh $new_db_bin;
+ close $fh;
+ print "Exported to $file\n";
+ } else {
+ print "Could not open \"$file\" for writing.\n";
+ }
+
+ return 0;
+}
+
+# A helper function for cli_export() and cli_import(). It takes a kdb object,
+# a group as a starting point to copy from, and optionally a parent_group to
+# copy to. It copies everything from the source group's root downward. In our
+# use cases, the _target_ $kdb object passed in here is typically a different
+# one than the _source_ $group is from.
+sub copy_kdb_group_tree($$$) {
+ my $kdb=shift @_;
+ my $group=shift @_;
+ my $parent_group=shift @_ || undef; # When undef, it writes to the root
+
+ # Add the new group, to it's parent or root if $parent_group==undef
+ my $new_group=$kdb->add_group({
+ title => $group->{title},
+ icon => $group->{icon},
+ id => $group->{id},
+ group => $parent_group,
+ });
+
+ # Add the new_group's entries
+ if (ref($group->{entries}) eq 'ARRAY') {
+ foreach my $entry (@{$group->{entries}}) {
+ $entry->{group} = $new_group;
+ $kdb->add_entry($entry);
+ }
+ }
+
+ # Add the new_group's child groups
+ if (ref($group->{groups}) eq 'ARRAY') {
+ foreach my $child_grp (@{$group->{groups}}) {
+ copy_kdb_group_tree($kdb,$child_grp,$new_group);
+ }
+ }
+}
+
sub cli_saveas($) {
my $file=shift @_;
+ my $key_file=shift @_;
our $state;
my $master_pass=GetMasterPasswd();
print "Retype to verify: ";
+ ReadMode('noecho');
my $checkval = ReadLine(0);
+ ReadMode('normal');
chomp $checkval;
print "\n";
if ($master_pass ne $checkval) {
@@ -1150,15 +1375,17 @@ sub cli_saveas($) {
destroy_found();
scrub_unknown_values_from_all_groups(); # TODO - remove later
$state->{kdb}->unlock;
- $state->{kdb}->save_db($file,$master_pass);
+ $state->{kdb}->save_db($file,composite_master_pass($master_pass,$key_file));
$state->{kdb}->lock;
$state->{kdb}= File::KeePass->new;
- if (! eval { $state->{kdb}->load_db($file, $master_pass) }) {
+ if (! eval { $state->{kdb}->load_db($file,
+ composite_master_pass($master_pass,$key_file)) }) {
die "Couldn't load the file $file: $@";
}
-
+ $state->{kdb_has_changed}=0;
$state->{kdb_file} = $file;
+ $state->{key_file} = $key_file;
$state->{put_master_passwd}($master_pass);
$master_pass="\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
return 0;
@@ -1209,14 +1436,26 @@ sub cli_rmdir($) {
my $group_id = $state->{all_grp_paths_fwd}->{$grp_path};
my $group = $state->{kdb}->find_group({ id => $group_id });
my $entry_cnt=0;
- if (defined($group->{entries})) { $entry_cnt=scalar(@{$group->{entries}}); }
+ if (defined($group->{entries})) {
+ $entry_cnt=
+ scalar(grep(m/^$grp_path\0/,keys %{$state->{all_ent_paths_fwd}}));
+ }
my $group_cnt=0;
- if (defined($group->{groups})) { $group_cnt=scalar(@{$group->{groups}}); }
- if ( ($entry_cnt + $group_cnt) == 0) {
- my $deleted_group = $state->{kdb}->delete_group({ id => $group_id });
- } else {
- print "First remove its $entry_cnt entries and $group_cnt sub-groups.\n";
+ if (defined($group->{entries})) {
+ $group_cnt=
+ scalar(grep(m/^$grp_path\0/,keys %{$state->{all_grp_paths_fwd}}));
+ }
+ my $child_cnt=$entry_cnt + $group_cnt;
+ if ( $child_cnt > 0) {
+ print "WARNING: This group has $child_cnt child groups and/or entries.\n" .
+ "Really remove it!? [y/N] ";
+ my $key=get_single_key();
+ print "\n";
+ if (lc($key) ne 'y') {
+ return -1;
+ }
}
+ my $deleted_group = $state->{kdb}->delete_group({ id => $group_id });
# Because we removed a group we need to refresh our state paths
refresh_state_all_paths();
@@ -1280,8 +1519,16 @@ sub humanize_path($) {
sub cli_open($) {
my $path=shift @_;
+ my $key=shift @_;
+ our $state;
+
+ # If cli_close() does not return 0 the user decided not to close the file
+ if (cli_close() != 0) {
+ return -1;
+ }
+
if ( -f $path ) {
- my $err = open_kdb($path);
+ my $err = open_kdb($path, $key);
if (length($err)) {
print "Error opening file: $err\n";
}
@@ -1310,15 +1557,27 @@ sub cli_close {
my $key=get_single_key();
print "\n";
if (lc($key) ne 'y') {
- return;
+ return -1;
}
}
+ new_kdb($state);
+ return 0;
+}
+
+# This sets $state to a brand new, KeePassX-style, empty, unsaved database
+sub new_kdb($) {
+ my $state=shift @_;
$state->{kdb_has_changed}=0;
$state->{'kdb'} = File::KeePass->new;
+ # To be compatible with KeePassX
+ $state->{'kdb'}->add_group({ title => 'eMail' });
+ $state->{'kdb'}->add_group({ title => 'Internet' });
+ refresh_state_all_paths();
if (-f $state->{placed_lock_file}) { unlink($state->{placed_lock_file}); }
delete($state->{placed_lock_file});
delete($state->{kdb_file});
+ delete($state->{key_file});
delete($state->{master_pass});
cli_cd($term, {'args' => ["/"]});
}
@@ -1457,7 +1716,7 @@ sub GetMasterPasswd {
sub MyGetOpts {
my %opts=();
- my $result = &GetOptions(\%opts, "kdb=s", "help", "h");
+ my $result = &GetOptions(\%opts, "kdb=s", "key=s", "help", "h");
# If the user asked for help or GetOptions complained, give help and exit
if ($opts{help} || $opts{h} || (! int($result))) {
@@ -1470,6 +1729,10 @@ sub MyGetOpts {
push @errs, "for option --kdb=<file.kbd>, the file must exist.";
}
+ if ((length($opts{key}) && (! -e $opts{key}))) {
+ push @errs, "for option --key=<file.key>, the file must exist.";
+ }
+
if (scalar(@errs)) {
warn "There were errors:\n" .
" " . join("\n ", @errs) . "\n\n";
@@ -1480,10 +1743,11 @@ sub MyGetOpts {
}
sub GetUsageMessage {
- my $t="Usage: $APP_NAME [--kdb=<file.kdb>]\n" .
+ my $t="Usage: $APP_NAME [--kdb=<file.kdb>] [--key=<file.key>]\n" .
"\n" .
" --help\tThis message.\n" .
" --kdb\tOptional KeePass 1.x database file to open (must exist)\n" .
+ " --key\tOptional KeePass 1.x key file (must exist)\n" .
"\n" .
"Run kpcli with no options and type 'help' at its command prompt to learn\n" .
"about kpcli's commands.\n";
@@ -1491,6 +1755,17 @@ sub GetUsageMessage {
return $t;
}
+# Because Term::ShellUI has a fixed width (%20s) for the command length
+# and we don't need nearly that much, we had to implement our own help
+# function instead of using the built-in help_call() method.
+sub my_help_call($) {
+ my $term = shift @_;
+ my $help = $term->get_all_cmd_summaries($term->commands());
+ $help =~ s/^ {12}//gm; # Trim some leading spaces off of each line of output
+ print $help;
+ return 0;
+}
+
########################################################################
# Command Completion Routines ##########################################
########################################################################
@@ -1601,17 +1876,46 @@ sub encrypt_rijndael_cbc {
$buffer .= chr($extra) for 1 .. $extra;
return $cipher->encrypt($buffer);
}
+sub composite_master_pass($$) {
+ my ($pass, $key_file) = @_;
+
+ # composite password in case of key file
+ if (defined $key_file and length($key_file) and -f $key_file) {
+ open(my $fh,'<',$key_file) || die "Couldn't open key file $key_file: $!\n";
+ my $size = -s $key_file;
+ read($fh, my $buffer, $size);
+ close $fh;
+ if (length($buffer) != $size) {
+ die "Couldn't read entire key file contents of $key_file.\n";
+ }
+
+ $pass = substr(sha256($pass),0,32);
+ if ($size == 32) {
+ $pass .= $buffer;
+ } elsif ($size == 64) {
+ for (my $i = 0; $i < 64; $i += 2) {
+ $pass .= chr(hex(substr($buffer,$i,2)));
+ }
+ } else {
+ $pass .= substr(sha256($buffer),0,32);
+ }
+ }
+
+ return $pass;
+}
sub put_master_passwd($) {
my $master_pass = shift @_;
our $state;
+ $state->{'master_pass_key'}='';
$state->{'master_pass_key'} .= chr(int(255 * rand())) for 1..16;
+ $state->{'master_pass_enc_iv'}='';
$state->{'master_pass_enc_iv'} .= chr(int(255 * rand())) for 1..16;
$master_pass='CLEAR:' . $master_pass;
$state->{'master_pass'}=encrypt_rijndael_cbc($master_pass,
$state->{'master_pass_key'}, $state->{'master_pass_enc_iv'});
return 0;
}
-sub get_master_passwd($) {
+sub get_master_passwd() {
our $state;
my $master_pass=decrypt_rijndael_cbc($state->{master_pass},
$state->{'master_pass_key'}, $state->{'master_pass_enc_iv'});
@@ -1627,6 +1931,7 @@ sub warn_if_file_changed {
our $state;
my $file = $state->{kdb_file};
+ if (! length($file)) { return 0; } # If no file was opened, don't warn
my $file_md5 = Digest::file::digest_file_hex($file, "MD5");
if ($state->{kdb_file_md5} ne $file_md5) {
my $bold="\e[1m";
@@ -1650,6 +1955,25 @@ sub warn_if_file_changed {
return 0;
}
+sub generatePassword {
+ my $length = shift;
+ my @normal_chars=('a'..'z','A'..'Z',0..9);
+ my @special_chars=qw(_);
+ my $charset = join('', (@normal_chars,@special_chars));
+ # Generate the password
+ my $password = '';
+ while (length($password) < $length) {
+ $password .= substr($charset, (int(rand(length($charset)))), 1);
+ }
+ # Make sure that at least one special character appears
+ my $sccc=join('', @special_chars);
+ if ($password !~ m/[\Q$sccc\E]/) {
+ my $sc=$special_chars[int(rand(length($sccc)))];
+ substr($password,int(rand(length($password))), 1, $sc);
+ }
+ return $password
+}
+
########################################################################
# Unix-style, "touch" a file
########################################################################
@@ -1685,6 +2009,10 @@ program was inspired by my use of "kedpm -c" combined with my need
to migrate to KeePass. The curious can read about the Ked Password
Manager at http://http://kedpm.sourceforge.net/.
+=head1 USAGE
+
+Please run the program and type "help" to learn how to use it.
+
=head1 PREREQUISITES
This script requires these non-core modules:
@@ -1779,7 +2107,7 @@ This program may be distributed under the same terms as Perl itself.
back into place after realizing that v0.03 of
File::KeePass did not resolve all of the problems.
2011-Apr-23 - v1.0 - Changed a perl 5.10+ regex to a backward-compatable
- one to resolve SourceForge bug # 3192413.
+ one to resolve SourceForge bug number 3192413.
Modified the way that the /Backup group is ignored
by the find command to stop kpcli from croaking on
multiple entries with the same name in that group.
@@ -1792,7 +2120,25 @@ This program may be distributed under the same terms as Perl itself.
Term::ShellUI's complete_history() method was
removed between v0.86 and v0.9 and so I removed
kpli's call to it (Ctrl-r works for history).
- Added the "icons" commands.
+ Added the "icons" command.
+ 2011-Sep-07 - v1.1 - Empty DBs are now initialized to KeePassX style.
+ Fixed a couple of bugs in the find command.
+ Fixed a password noecho bug in the saveas command.
+ Fixed a kdb_has_changed bug in the saveas command.
+ Fixed a cli_open bug where it wasn't cli_close'ing.
+ Fixed variable init bugs in put_master_passwd().
+ Fixed a false warning in warn_if_file_changed().
+ 2011-Sep-30 - v1.2 - Added the "export" command.
+ Added the "import" command.
+ Command "rmdir" asks then deletes non-empty groups.
+ Command "new" can auto-generate random passwords.
+ 2012-Mar-03 - v1.3 - Fixed bug in cl command as reported in SourceForge
+ bug number 3496544.
+ 2012-Apr-17 - v1.4 - Added key file support based on a user contributed
+ patch with SourceForge ID# 3518388.
+ Added my_help_call() to allow for longer and more
+ descriptive command summaries (for help command).
+ Stopped allowing empty passwords for export.
=head1 TODO ITEMS
Please sign in to comment.
Something went wrong with that request. Please try again.