ssh-askpass

   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