#!/usr/bin/perl -w # Written by Tommi Virtanen . 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', '' => 'invoke'); $main->bind('', [$ok => 'invoke']); $main->bind('', [$cancel => 'invoke']); $main->bind('' => [$main => 'grabGlobal']); MainLoop; } ask ($#ARGV==0 ? $ARGV[0] : 'Please enter your authentication passphrase:');