openssh/ssh-askpass

39 lines
1.0 KiB
Perl
Executable File

#!/usr/bin/perl -w
# Written by Tommi Virtanen <tv@debian.org>. Consider it public domain.
use strict;
use Tk;
sub do_it($$;) {
my ($passphrase, $main) = @_;
print $passphrase->get(), "\n";
$main->destroy();
}
sub ask($;) {
my ($prompt)=@_;
my $main=MainWindow->new;
$main->Label(-text=>$prompt)->pack(-fill=>'x');
my $passphrase=$main->Entry(-show=>'*')->pack(-fill=>'x');
$passphrase->focus();
my $buttons=$main->Frame;
$buttons->pack(-side=>'right');
my $ok=$buttons->Button(-text=>'Ok',
-command=>sub {do_it $passphrase, $main}
)->pack(-side=>'left');
my $cancel=$buttons->Button(-text=>'Cancel', -command=>[$main=>'destroy'])
->pack(-side=>'right');
$main->bind('Tk::Button', '<Return>' => 'invoke');
$main->bind('<Return>', [$ok => 'invoke']);
$main->bind('<Escape>', [$cancel => 'invoke']);
$main->bind('<Visibility>' => [$main => 'grabGlobal']);
MainLoop;
}
ask ($#ARGV==0
? $ARGV[0]
: 'Please enter your authentication passphrase:');