]>
Commit | Line | Data |
---|---|---|
e1a9c08d | 1 | #!/usr/bin/perl -w |
2 | ||
3 | # Written by Tommi Virtanen <tv@debian.org>. Consider it public domain. | |
4 | ||
5 | use strict; | |
6 | use Tk; | |
7 | ||
8 | sub do_it($$;) { | |
9 | my ($passphrase, $main) = @_; | |
10 | print $passphrase->get(), "\n"; | |
11 | $main->destroy(); | |
12 | } | |
13 | ||
14 | sub ask($;) { | |
15 | my ($prompt)=@_; | |
16 | my $main=MainWindow->new; | |
17 | $main->Label(-text=>$prompt)->pack(-fill=>'x'); | |
18 | my $passphrase=$main->Entry(-show=>'*')->pack(-fill=>'x'); | |
19 | $passphrase->focus(); | |
20 | my $buttons=$main->Frame; | |
21 | $buttons->pack(-side=>'right'); | |
22 | my $ok=$buttons->Button(-text=>'Ok', | |
23 | -command=>sub {do_it $passphrase, $main} | |
24 | )->pack(-side=>'left'); | |
25 | my $cancel=$buttons->Button(-text=>'Cancel', -command=>[$main=>'destroy']) | |
26 | ->pack(-side=>'right'); | |
27 | $main->bind('Tk::Button', '<Return>' => 'invoke'); | |
28 | $main->bind('<Return>', [$ok => 'invoke']); | |
29 | $main->bind('<Escape>', [$cancel => 'invoke']); | |
30 | $main->bind('<Visibility>' => [$main => 'grabGlobal']); | |
31 | ||
32 | MainLoop; | |
33 | } | |
34 | ||
35 | ask ($#ARGV==0 | |
36 | ? $ARGV[0] | |
37 | : 'Please enter your authentication passphrase:'); | |
38 |