view release on metacpan or  search on metacpan

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

        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