webmin/gnupg-lib.pl

   1 # gnupg-lib.pl
   2 # Functions for managing gnupg keys, signing, encrypting and so on
   3
   4 BEGIN { push(@INC, ".."); };
   5 use strict;
   6 use warnings;
   7 use WebminCore;
   8 our ($module_name, %config, $user_module_config_directory, %text);
   9
  10 if (!$module_name) {
  11         # Only do this if we are the primary library for the usermin gnupg mod
  12         &init_config();
  13         &switch_to_remote_user();
  14         &create_user_config_dirs();
  15         }
  16 &foreign_require("proc", "proc-lib.pl");
  17
  18 our $gpgpath = $config{'gpg'} || "gpg";
  19
  20 # list_keys()
  21 # Returns an array of all GnuPG keys
  22 sub list_keys
  23 {
  24 my (@rv, %kmap);
  25 &clean_language();
  26 open(GPG, "$gpgpath --list-keys 2>/dev/null |");
  27 while(<GPG>) {
  28         if (/^pub\s+(\S+)\/(\S+)\s+(\S+)\s+(.*)\s+<(\S+)>/ ||
  29             /^pub\s+(\S+)\/(\S+)\s+(\S+)\s+(.*)/) {
  30                 my $k = { 'size' => $1,
  31                              'key' => $2,
  32                              'date' => $3,
  33                              'name' => $4 ? [ $4 ] : [ ],
  34                              'email' => $5 ? [ $5 ] : $4 ? [ "" ] : [ ],
  35                              'index' => scalar(@rv) };
  36                 if ($k->{'name'}->[0] &&
  37                     $k->{'name'}->[0] =~ /\[(expires|expired):\s+(\S+)\]/) {
  38                         # Expiry date, the actual name
  39                         $k->{'expires'} = $2;
  40                         $k->{'expired'} = 1 if ($1 eq 'expired');
  41                         shift(@{$k->{'name'}});
  42                         }
  43                 $kmap{$k->{'key'}} = $k;
  44                 while(1) {
  45                         $_ = <GPG>;
  46                         last if ($_ !~ /\S/);
  47                         if (/^sub\s+(\S+)\/(\S+)\s+/) {
  48                                 push(@{$k->{'key2'}}, $2);
  49                                 }
  50                         elsif (/^uid\s+(.*)\s+<(\S+)>/ ||
  51                                /^uid\s+(.*)/) {
  52                                 push(@{$k->{'name'}}, $1);
  53                                 push(@{$k->{'email'}}, $2);
  54                                 }
  55                         }
  56                 push(@rv, $k);
  57                 }
  58         }
  59 close(GPG);
  60 open(GPG, "$gpgpath --list-secret-keys 2>/dev/null |");
  61 while(<GPG>) {
  62         if (/^sec\s+(\S+)\/(\S+)\s+(\S+)\s+(.*)/ && $kmap{$2}) {
  63                 $kmap{$2}->{'secret'}++;
  64                 }
  65         }
  66 close(GPG);
  67 &reset_environment();
  68 return @rv;
  69 }
  70
  71 # list_keys_sorted()
  72 # Returns a list of all keys, sorted by name
  73 sub list_keys_sorted
  74 {
  75 return sort { lc($a->{'name'}->[0]) cmp lc($b->{'name'}->[0]) }
  76             &list_keys();
  77 }
  78
  79 # list_secret_keys()
  80 # List list_keys, but only returns secret ones
  81 sub list_secret_keys
  82 {
  83 return grep { $_->{'secret'} } &list_keys();
  84 }
  85
  86 # key_fingerprint(&key)
  87 sub key_fingerprint
  88 {
  89 my $fp;
  90 local $_;
  91 &clean_language();
  92 open(GPG, "$gpgpath --fingerprint \"$_[0]->{'name'}->[0]\" |");
  93 while(<GPG>) {
  94         if (/fingerprint\s+=\s+(.*)/) {
  95                 $fp = $1;
  96                 }
  97         }
  98 close(GPG);
  99 &reset_environment();
 100 return $fp;
 101 }
 102
 103 # get_passphrase(&key)
 104 sub get_passphrase
 105 {
 106 open(PASS, "$user_module_config_directory/pass.$_[0]->{'key'}") ||
 107   open(PASS, "$user_module_config_directory/pass") || return undef;
 108 my $pass = <PASS>;
 109 close(PASS);
 110 chop($pass);
 111 return $pass;
 112 }
 113
 114 # put_passphrase(pass, &key)
 115 sub put_passphrase
 116 {
 117 my $fh;
 118 &open_tempfile($fh, ">$user_module_config_directory/pass.$_[1]->{'key'}");
 119 &print_tempfile($fh, $_[0],"\n");
 120 &close_tempfile($fh);
 121 chmod(0700, "$user_module_config_directory/pass.$_[1]->{'key'}");
 122 }
 123
 124 # encrypt_data(data, &result, &key|&keys, ascii)
 125 # Encrypts some data with the given public key and returns the result, and
 126 # returns an error message or undef on failure
 127 sub encrypt_data
 128 {
 129 my $srcfile = &transname();
 130 my @keys = ref($_[2]) eq 'ARRAY' ? @{$_[2]} : ( $_[2] );
 131 my $rcpt = join(" ", map { "--recipient \"$_->{'name'}->[0]\"" } @keys);
 132 &write_entire_file($srcfile, $_[0]);
 133 my $dstfile = &transname();
 134 my $ascii = $_[3] ? "--armor" : "";
 135 my $comp = $config{'compress'} eq '' ? "" :
 136                 " --compress-algo $config{'compress'}";
 137 &clean_language();
 138 my $cmd = "$gpgpath --output $dstfile $rcpt $ascii $comp --encrypt $srcfile";
 139 my ($fh, $fpid) = &foreign_call("proc", "pty_process_exec", $cmd);
 140 while(1) {
 141         my $rv = &wait_for($fh, "anyway");
 142         if ($rv == 0) {
 143                 syswrite($fh, "yes\n", length("yes\n"));
 144                 }
 145         elsif ($rv < 0) {
 146                 last;
 147                 }
 148         }
 149 close($fh);
 150 &reset_environment();
 151 unlink($srcfile);
 152 my $dst = &read_entire_file($dstfile);
 153 unlink($dstfile);
 154 if ($dst) {
 155         ${$_[1]} = $dst;
 156         return undef;
 157         }
 158 else {
 159         return $wait_for_input;
 160         }
 161 }
 162
 163 # decrypt_data(data, &result)
 164 # Decrypts some data encrypted for the current GnuPG user, and puts the results
 165 # into &result. Returns an error message or undef on success.
 166 sub decrypt_data
 167 {
 168 my $srcfile = &transname();
 169 &write_entire_file($srcfile, $_[0]);
 170 my $dstfile = &transname();
 171 &clean_language();
 172 my $cmd = "$gpgpath --output $dstfile --decrypt $srcfile";
 173 my ($fh, $fpid) = &foreign_call("proc", "pty_process_exec", $cmd);
 174 my ($error, $seen_pass, $pass, $key, $keyid);
 175 while(1) {
 176         my $rv = &wait_for($fh, "passphrase:", "key,\\s+ID\\s+(\\S+),", "failed.*\\n", "error.*\\n", "invalid.*\\n", "signal caught.*\\n");
 177         if ($rv == 0) {
 178                 last if ($seen_pass++);
 179                 sleep(1);
 180                 syswrite($fh, "$pass\n", length("$pass\n"));
 181                 }
 182         elsif ($rv == 1) {
 183                 $keyid = $matches[1];
 184                 ($key) = grep { &indexof($matches[1], @{$_->{'key2'}}) >= 0 }
 185                               &list_secret_keys();
 186                 $pass = &get_passphrase($key) if ($key);
 187                 }
 188         elsif ($rv > 1) {
 189                 $error++;
 190                 last;
 191                 }
 192         elsif ($rv < 0) {
 193                 last;
 194                 }
 195         }
 196 close($fh);
 197 &reset_environment();
 198 unlink($srcfile);
 199 my $dst = &read_entire_file($dstfile);
 200 unlink($dstfile);
 201 if (!$keyid) {
 202         return $text{'gnupg_ecryptid'};
 203         }
 204 elsif (!$key) {
 205         return &text('gnupg_ecryptkey', "<tt>$keyid</tt>");
 206         }
 207 elsif (!defined($pass)) {
 208         return &text('gnupg_ecryptpass', $key->{'name'}->[0]).". ".
 209             &text('gnupg_canset', "/gnupg/edit_key.cgi?key=$key->{'key'}").".";
 210         }
 211 elsif ($error || $seen_pass > 1) {
 212         return "<pre>$wait_for_input</pre>";
 213         }
 214 else {
 215         ${$_[1]} = $dst;
 216         return undef;
 217         }
 218 }
 219
 220 # sign_data(data, \&result, &key, mode)
 221 # Signs the given data and returns the result. Mode 0 = binary signature
 222 # mode 1 = ascii signature at end, mode 2 = ascii signature only
 223 sub sign_data
 224 {
 225 my $srcfile = &transname();
 226 &write_entire_file($srcfile, $_[0]);
 227 my $dstfile = &transname();
 228 my $cmd;
 229 if ($_[3] == 0) {
 230         $cmd = "$gpgpath --output $dstfile --default-key $_[2]->{'key'} --sign $srcfile";
 231         }
 232 elsif ($_[3] == 1) {
 233         $cmd = "$gpgpath --output $dstfile --default-key $_[2]->{'key'} --clearsign $srcfile";
 234         }
 235 elsif ($_[3] == 2) {
 236         $cmd = "$gpgpath --armor --output $dstfile --default-key $_[2]->{'key'} --detach-sig $srcfile";
 237         }
 238 &clean_language();
 239 my ($fh, $fpid) = &foreign_call("proc", "pty_process_exec", $cmd);
 240 &reset_environment();
 241 my ($error, $seen_pass);
 242 my $pass = &get_passphrase($_[2]);
 243 if (!defined($pass)) {
 244         return $text{'gnupg_esignpass'}.". ".
 245             &text('gnupg_canset', "/gnupg/edit_key.cgi?key=$_[2]->{'key'}").".";
 246         }
 247 while(1) {
 248         my $rv = &wait_for($fh, "passphrase:", "failed", "error");
 249         if ($rv == 0) {
 250                 last if ($seen_pass++);
 251                 sleep(1);
 252                 syswrite($fh, "$pass\n", length("$pass\n"));
 253                 }
 254         elsif ($rv > 0) {
 255                 $error++;
 256                 last;
 257                 }
 258         elsif ($rv < 0) {
 259                 last;
 260                 }
 261         }
 262 close($fh);
 263 unlink($srcfile);
 264 my $dst = &read_entire_file($dstfile);
 265 unlink($dstfile);
 266 if ($error || $seen_pass > 1) {
 267         return "<pre>$wait_for_input</pre>";
 268         }
 269 else {
 270         ${$_[1]} = $dst;
 271         return undef;
 272         }
 273 }
 274
 275 # verify_data(data, [signature])
 276 # Verifies the signature on some data, and returns a status code and a message
 277 # code 0 = verified successfully, message contains signer
 278 # code 1 = verified successfully but no trust chain, message contains signer
 279 # code 2 = failed to verify, message contains signer
 280 # code 3 = do not have signers public key, message contains ID
 281 # code 4 = verification totally failed, message contains reason
 282 sub verify_data
 283 {
 284 my $datafile = &transname();
 285 &write_entire_file($datafile, $_[0]);
 286 my $cmd;
 287 my $sigfile;
 288 if (!$_[1]) {
 289         $cmd = "$gpgpath --verify $datafile";
 290         }
 291 else {
 292         $sigfile = &transname();
 293         &write_entire_file($sigfile, $_[1]);
 294         $cmd = "$gpgpath --verify $sigfile $datafile";
 295         }
 296 #local ($fh, $fpid) = &foreign_call("proc", "pty_process_exec", $cmd);
 297 #&wait_for($fh);
 298 #close($fh);
 299 #local $out = $wait_for_input;
 300 &clean_language();
 301 my $out = &backquote_command("$cmd 2>&1 </dev/null");
 302 &reset_environment();
 303 unlink($datafile);
 304 unlink($sigfile) if ($sigfile);
 305 if ($out =~ /BAD signature from "(.*)"/i) {
 306         return (2, $1);
 307         }
 308 elsif ($out =~ /key ID (\S+).*\n.*not found/i) {
 309         return (3, $1);
 310         }
 311 elsif ($out =~ /Good signature from "(.*)"/i) {
 312         my $signer = $1;
 313         if ($out =~ /warning/) {
 314                 return (1, $signer);
 315                 }
 316         else {
 317                 return (0, $signer);
 318                 }
 319         }
 320 else {
 321         return (4, $out);
 322         }
 323 }
 324
 325 # read_entire_file(file)
 326 sub read_entire_file
 327 {
 328 my ($rv, $buf);
 329 open(FILE, $_[0]) || return undef;
 330 while(read(FILE, $buf, 1024) > 0) {
 331         $rv .= $buf;
 332         }
 333 close(FILE);
 334 return $rv;
 335 }
 336
 337 # write_entire_file(file, data)
 338 sub write_entire_file
 339 {
 340 my $fh;
 341 &open_tempfile($fh, ">$_[0]");
 342 &print_tempfile($fh, $_[1]);
 343 &close_tempfile($fh);
 344 }
 345
 346 # get_trust_level(&key)
 347 # Returns the trust level of a key
 348 sub get_trust_level
 349 {
 350 &clean_language();
 351 my $cmd = "$gpgpath --edit-key \"$_[0]->{'name'}->[0]\"";
 352 my ($fh, $fpid) = &foreign_call("proc", "pty_process_exec", $cmd);
 353 my $rv = &wait_for($fh, "trust:\\s+(.)", "command>");
 354 my $tr;
 355 if ($rv == 0) {
 356         $tr = $matches[1] eq "q" ? 1 : $matches[1] eq "n" ? 2 :
 357               $matches[1] eq "m" ? 3 : $matches[1] eq "f" ? 4 : 0;
 358         }
 359 else {
 360         $tr = -1;
 361         }
 362 syswrite($fh, "quit\n", length("quit\n"));
 363 close($fh);
 364 &reset_environment();
 365 return $tr;
 366 }
 367
 368 # delete_key(&key)
 369 # Delete one public or secret key
 370 sub delete_key
 371 {
 372 my ($key) = @_;
 373 if ($key->{'secret'}) {
 374         &clean_language();
 375         my $cmd = "$gpgpath --delete-secret-key \"$key->{'name'}->[0]\"";
 376         my ($fh, $fpid) = &foreign_call("proc", "pty_process_exec", $cmd);
 377         &wait_for($fh, "\\?");
 378         syswrite($fh, "y\n");
 379         &wait_for($fh, "\\?");
 380         syswrite($fh, "y\n");
 381         sleep(1);
 382         close($fh);
 383         &reset_environment();
 384         }
 385 &clean_language();
 386 my $cmd = "$gpgpath --delete-key \"$key->{'name'}->[0]\"";
 387 my ($fh, $fpid) = &foreign_call("proc", "pty_process_exec", $cmd);
 388 &wait_for($fh, "\\?");
 389 syswrite($fh, "y\n");
 390 sleep(1);
 391 close($fh);
 392 &reset_environment();
 393 }
 394
 395 # default_email_address()
 396 # Returns the current user's email address, or undef if not possible
 397 sub default_email_address
 398 {
 399 if (&foreign_check("mailbox")) {
 400         &foreign_require("mailbox", "mailbox-lib.pl");
 401         my ($fromaddr) = &mailbox::split_addresses(
 402                         &mailbox::get_preferred_from_address());
 403         if ($fromaddr) {
 404                 return $fromaddr->[0];
 405                 }
 406         }
 407 return undef;
 408 }
 409
 410 # fetch_gpg_key(id)
 411 # Imports a key by ID from the configured keyserver. Returns 0 on success,
 412 # 1 on failure, 2 if there was no change, 3 if the import appeared to success
 413 # but the key isn't visible.
 414 sub fetch_gpg_key
 415 {
 416 my ($id) = @_;
 417 my $out = &backquote_command(
 418         "$gpgpath --keyserver ".quotemeta($config{'keyserver'}).
 419         " --recv-key ".quotemeta($id)." 2>&1 </dev/null");
 420 my @keys = &list_keys();
 421 my ($key) = grep { lc($_->{'key'}) eq lc($id) } @keys;
 422 if ($?) {
 423         return wantarray ? (1, $out) : 1;
 424         }
 425 elsif ($out =~ /not\s+changed/) {
 426         return wantarray ? (2, $key) : 2;
 427         }
 428 else {
 429         if ($key) {
 430                 return (0, $key);
 431                 }
 432         else {
 433                 return (3, $out);
 434                 }
 435         }
 436 }
 437
 438 # search_gpg_keys(word)
 439 # Searches the configured keyserver for GPG keys matching some name or email
 440 # address, and returns them as a list of hash refs
 441 sub search_gpg_keys
 442 {
 443 my ($word) = @_;
 444 my $cmd = "$gpgpath --keyserver ".quotemeta($config{'keyserver'}).
 445              " --search-keys ".quotemeta($word);
 446 my ($fh, $fpid) = &foreign_call("proc", "pty_process_exec", $cmd);
 447 my @rv;
 448 while(1) {
 449         $wait_for_input = undef;
 450         my $rv = &wait_for($fh, "N.ext, or Q.uit");
 451         if ($rv < 0) { last; }
 452         my $count = 0;
 453         my $key;
 454         foreach my $l (split(/\r?\n/, $wait_for_input)) {
 455                 if ($l =~ /^\(\d+\)\s+(\d+)\s+bit\s+(\S+)\s+key\s+(\S+)/) {
 456                         # Key with no name .. skip!
 457                         }
 458                 elsif ($l =~ /^\(\d+\)\s+(\S.*)\s+<(\S+)>/ ||
 459                        $l =~ /^\(\d+\)\s+(\S.*)/) {
 460                         # First name and email for a key
 461                         $key = { 'name' => [ $1 ],
 462                                  'email' => [ $2 ] };
 463                         $key->{'name'} =~ s/\s+$//;
 464                         push(@rv, $key);
 465                         $count++;
 466                         }
 467                 elsif ($l =~ /^\s+(\S.*)\s+<(\S+)>/ && $key) {
 468                         # Additional name and email
 469                         push(@{$key->{'name'}}, $1);
 470                         push(@{$key->{'email'}}, $2);
 471                         }
 472                 elsif ($l =~ /\s+(\d+)\s+bit\s+(\S+)\s+key\s+(\S+),\s+created:\s+(\S+)/ && $key) {
 473                         # Size and ID
 474                         $key->{'size'} = $1;
 475                         $key->{'key'} = $3;
 476                         $key->{'date'} = $4;
 477                         if ($l =~ /revoked/) {
 478                                 $key->{'revoked'} = 1;
 479                                 }
 480                         $key = undef;
 481                         }
 482                 }
 483         if ($count) {
 484                 &sysprint($fh, "N\n");
 485                 }
 486         else {
 487                 last;
 488                 }
 489         }
 490 close($fh);
 491 return @rv;
 492 }
 493
 494 1;
 495