view release on metacpan or  search on metacpan

lib/File/KeePass/Agent/unix.pm  view on Meta::CPAN

sub _menu_entries {
    my ($self, $file, $gid) = @_;
    my ($kdb) = map {$_->[1]} grep {$_->[0] eq $file} @{ $self->keepass };
    my $g = $kdb->find_group({id => $gid}) || do { print "\nNo such matching gid ($gid) in file ($file)\n\n"; return };
    local $g->{'groups'}; # don't recurse while looking for entries since we are already flat
    my @E = $kdb->find_entries({}, [$g]);
    if (! @E) {
        print "\nNo group entries in $g->{'title'}\n\n";
        return;
    }
    my $t = $self->_clear."\n  File: $file\n";
    $t .= "    Group: $g->{'title'}\n";

    my $i = 0;
    my $cb = {};
    my @e;
    my $max = 0;
    for my $e (@E) {
        my $key = _a2z($i++);
        $cb->{$key} = ['_menu_entry', $file, $e->{'id'}, $gid];
        push @e, "      ($key)   $e->{'title'}";
        $max = length($e[-1]) if length($e[-1]) > $max;
    }

    my ($W, $H) = eval { Term::ReadKey::GetTerminalSize(\*STDOUT) };
    my $cols = int($W / ($max || 1));
    my $rows = @e / $cols; $rows = int(1 + $rows) if int($rows) != $rows;
    $rows = 8 if $rows < 8;
    my @row;
    $row[$_%$rows]->[$_/$rows] = $e[$_] for 0 .. @e;
    $t .= sprintf("%-${max}s"x@$_, @$_)."\n" for @row;
    print $t;
    return [$t, $cb];
}

sub _menu_entry {
    my ($self, $file, $eid, $gid, $action, $extra) = @_;
    my ($kdb) = map {$_->[1]} grep {$_->[0] eq $file} @{ $self->keepass };
    my $e = $kdb->find_entry({id => $eid}) || do { print "\nNo such matching eid ($eid) in file ($file)\n\n"; return };
    my $g = $kdb->find_group({id => $gid}) || do { print "\nNo such matching gid ($gid) in file ($file)\n\n"; return };

    my $cb = {};
    my $t = "\n  File: $file\n";
    $t .= "    Group: $g->{'title'}\n";
    $t .= "      Entry: $e->{'title'}\n";

    $cb->{'i'} = ['_menu_entry', $file, $e->{'id'}, $gid, 'info'];
    $cb->{'c'} = ['_menu_entry', $file, $e->{'id'}, $gid, 'comment'];
    $cb->{'p'} = ['_menu_entry', $file, $e->{'id'}, $gid, 'print_pass'];
    $cb->{'a'} = ['_menu_entry', $file, $e->{'id'}, $gid, 'auto_type'];
    $cb->{'1'} = ['_menu_entry', $file, $e->{'id'}, $gid, 'copy', 'password'];
    $cb->{'2'} = ['_menu_entry', $file, $e->{'id'}, $gid, 'copy', 'username'];
    $cb->{'3'} = ['_menu_entry', $file, $e->{'id'}, $gid, 'copy', 'url'];
    $cb->{'4'} = ['_menu_entry', $file, $e->{'id'}, $gid, 'copy', 'title'];
    $cb->{'5'} = ['_menu_entry', $file, $e->{'id'}, $gid, 'copy', 'comment'];
    $t .= "        (i)    Show entry information\n";
    $t .= "        (c)    Show entry comment\n";
    $t .= "        (p)    Print password\n";
    $t .= "        (a)    Run Auto-Type in 5 seconds\n";
    $t .= "        (1)    Copy password to clipboard\n";
    $t .= "        (2)    Copy username to clipboard\n";
    $t .= "        (3)    Copy url to clipboard\n";
    $t .= "        (4)    Copy title to clipboard\n";
    $t .= "        (5)    Copy comment to clipboard\n";
    my $i = 6;
    for my $key (sort keys %{ $e->{'strings'} || {} }) {
        my $k = $i++;
        $cb->{$k} = ['_menu_entry', $file, $e->{'id'}, $gid, 'copy', $key];
        $t .= "        ($k)    Copy string \"$key\" to clipboard\n";
    }
    for my $key (sort keys %{ $e->{'binary'} || {} }) {
        my $k = $i++;
        $cb->{$k} = ['_menu_entry', $file, $e->{'id'}, $gid, 'save', $key];
        $t .= "        ($k)    Save binary \"$key\" as...\n";
    }

    if (!$action) {
        print $self->_clear.$t;
        return [$t, $cb];
    }

    if ($action eq 'info') {
        foreach my $k (sort keys %$e) {
            next if $k eq 'comment' || $k eq 'comment';
            my $val = $e->{$k};
            if (ref($val) eq 'ARRAY') {
                next if $k eq 'history' && !@$val;
                $val = "(Previous versions: ".scalar(@$val).")" if $k eq 'history';
                $val = join '', map {"\n        \"$_->{'window'}\"  -->  \"$_->{'keys'}\""} @$val if $k eq 'auto_type';
            } elsif (ref($val) eq 'HASH') {
                next if $k eq 'binary' && ! scalar keys %$val;
                $val = join '', map {"\n        \"$_\"  (".length($val->{$_})." bytes)"} sort keys %$val if $k eq 'binary';
                $val = join '', map {"\n        \"$_\"  =  \"$val->{$_}\""} sort keys %$val if $k eq 'strings' || $k eq 'protected';
            }
            print "      $k: ".(defined($val) ? $val : "(null)")."\n";
        }
    } elsif ($action eq 'comment') {
        print "-------------------\n";
        if (! defined $e->{'comment'}) {
            print "--No comment--\n";
        } elsif (length $e->{'comment'}) {
            print "--Empty comment--\n";
        } else {
            print $e->{'comment'};
            print "\n--No newline--\n" if $e->{'comment'} !~ /\n$/;
        }
    } elsif ($action eq 'print_pass') {
        my $pass = $kdb->locked_entry_password($e);
        if (!defined $pass) {
            print "--No password defined--\n";
        } elsif (!length $pass) {
            print "--Zero length password--\n";
        } else {
            print "$pass\n";
        }
    } elsif ($action eq 'auto_type') {
        my $at = $e->{'auto_type'} || [];
        if (!@$at || !defined($at->[0]->{'keys'}) || !length($at->[0]->{'keys'})) {
            print "--No Auto-Type entry found for entry (defaulting to {PASSWORD}{ENTER})--\n";
            $at = [{keys => '{PASSWORD}{ENTER}'}];
        } elsif (@$at > 1) {
            print "--Multiple Auto-Type entries found in comment - using the first one--\n";
        }
        my $keys = $at->[0]->{'keys'};
        local $| = 1;
        print "\n";
        require IO::Select;
        my $sel = IO::Select->new(\*STDIN);
        for (reverse 1 .. 5) {
            print "\rRunning Auto-Type in $_... (any key to cancel)";
            my @fh = $sel->can_read(1);
            if (@fh) {
                read $fh[0], my $txt, 1;
                print $self->_clear.$t."\n\nAuto-type cancelled\n";
                return [];
            }
        }
        my ($wid) = $self->x->GetInputFocus;
        my $title = eval { $self->wm_name($wid) };

        print "\rSending Auto-Type to window: $title            \n";

        $self->do_auto_type({
            auto_type => $keys,
            file => $file,
            entry => $e,
        }, $title, undef);
    } elsif ($action eq 'copy') {
        my $data = ($extra eq 'password') ? $kdb->locked_entry_password($e) : exists($e->{$extra}) ? $e->{$extra} : $e->{'strings'}->{$extra};
        $data = '' if ! defined $data;
        $self->_copy_to_clipboard($data) || return;
        print "Sent $extra to clipboard\n";
        print "--Zero length $extra--\n" if ! length $data;
    } elsif ($action eq 'save') {
        if (my $file = $self->_file_prompt("Save file \"$extra\" as: ", $extra)) {
            if (open my $fh, ">", $file) {
                binmode $fh;
                print $fh $e->{'binary'}->{$extra};
                close $fh;
                print "Saved \"$extra\" as \"$file\"\n";
            } else {
                print "Could not open $file for writing: $!\n";
            }
        } else {
            print "File not saved\n";
        }
    } else {
        print "--Unknown action $action--\n";
    }
    return [];
}

sub _copy_to_clipboard {
    my ($self, $data) = @_;
    if (my $klip = eval {
        require Net::DBus;
        my $bus = Net::DBus->find;
        my $obj = $bus->get_service("org.freedesktop.DBus")->get_object("/org/freedesktop/DBus");
        my %h = map {$_ => 1} @{ $obj->ListNames };
        die "No klipper service found" unless $h{'org.kde.klipper'};
        return $bus->get_service('org.kde.klipper')->get_object('/klipper');
    }) {
        $klip->setClipboardContents($data);
        return 1;
    } elsif (-x '/usr/bin/xclip' && open(my $prog, '|-', '/usr/bin/xclip', '-selection', 'clipboard')) {
        print $prog $data;
        close $prog;
    } else {
        print "--No current clipboard service available\n";
        return;
    }
}

###----------------------------------------------------------------###

sub _ini_parse { # ick - my own config.ini reader - too bad the main cpan entries are overbloat
    my ($self, $file, $order) = @_;
    open my $fh, '<', $file or return {};
    my $block = '';
    my $c = {};
    while (defined(my $line = <$fh>)) {
        $line =~ s/^\s+//;
        $line =~ s/\s+$//;
        if ($line =~ /^ \[\s* (.*?) \s*\] $/x) {
            $block = $1;
            push @{ $c->{"\eorder\e"} }, $block if $order;
            next;
        } elsif (!length $line || $line =~ /^[;\#]/) {
            push @{ $c->{$block}->{"\eorder\e"} }, \$line if $order;
            next;
        }
        my ($key, $val) = split /\s*=\s*/, $line, 2;
        $c->{$block}->{$key} = $val;
        push @{ $c->{$block}->{"\eorder\e"} }, $key if $order;
    }
    return $c;
}

sub _ini_write {
    my ($self, $c, $file) = @_;
    open my $fh, "+<", $file or die "Could not open file $file for writing: $!";
    for my $block (@{ $c->{"\eorder\e"} || [sort keys %$c] }) {
        print $fh "[$block]\n" if length $block;
        my $ref = $c->{$block} || {};
        for my $key (@{ $ref->{"\eorder\e"} || [sort keys %$ref] }) {
            if (ref($key) eq 'SCALAR') {
                print $fh $$key,"\n";
            } else {
                print $fh "$key=".(defined($ref->{$key}) ? $ref->{$key} : '')."\n";
            }
        }
    }
    truncate $fh, tell($fh);
    close $fh;
}


=head1 DESCRIPTION

This module provides unix based support for the File::KeePassAgent.  It should
work for anything using an X server.  It should not normally be used on its own.

=head1 FKPA METHODS

The following methods must be provided by an FKPA OS variant.

=over 4

=item C<read_config>