blob: b1e23c514db5e37fc252b1407f9868fd9d650a09 [file] [log] [blame]
Damien Miller356a0b01999-11-08 15:30:59 +11001#!/usr/bin/perl -w
2
3# Written by Tommi Virtanen <tv@debian.org>. Consider it public domain.
4
5use strict;
6use Tk;
7
8sub do_it($$;) {
9 my ($passphrase, $main) = @_;
10 print $passphrase->get(), "\n";
11 $main->destroy();
12}
13
14sub 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
35ask ($#ARGV==0
36 ? $ARGV[0]
37 : 'Please enter your authentication passphrase:');
38