ssh-askpass


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

#!/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:');