1# 2# GnuPG.pm - Interface to the GNU Privacy Guard. 3# 4# This file is part of GnuPG.pm. 5# 6# Author: Francis J. Lacoste <francis.lacoste@Contre.COM> 7# 8# Copyright (C) 2000 iNsu Innovations Inc. 9# Copyright (C) 2001 Francis J. Lacoste 10# 11# This program is free software; you can redistribute it and/or modify 12# it under the terms of the GNU General Public License as published by 13# the Free Software Foundation; either version 2 of the License, or 14# (at your option) any later version. 15# 16# This program is distributed in the hope that it will be useful, 17# but WITHOUT ANY WARRANTY; without even the implied warranty of 18# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19# GNU General Public License for more details. 20# 21# You should have received a copy of the GNU General Public License 22# along with this program; if not, write to the Free Software 23# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 24# 25package GnuPG; 26 27 28use strict; 29 30use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS ); 31 32BEGIN { 33 require Exporter; 34 35 @ISA = qw(Exporter); 36 37 @EXPORT = qw(); 38 39 %EXPORT_TAGS = ( 40 algo => [ qw( RSA_RSA DSA_ELGAMAL DSA RSA ) ], 41 trust => [ qw( TRUST_UNDEFINED TRUST_NEVER 42 TRUST_MARGINAL TRUST_FULLY 43 TRUST_ULTIMATE ) ], 44 ); 45 46 Exporter::export_ok_tags( qw( algo trust ) ); 47 48 $VERSION = '0.19'; 49} 50 51use constant RSA_RSA => 1; 52use constant DSA_ELGAMAL => 2; 53use constant DSA => 3; 54use constant RSA => 4; 55 56use constant TRUST_UNDEFINED => -1; 57use constant TRUST_NEVER => 0; 58use constant TRUST_MARGINAL => 1; 59use constant TRUST_FULLY => 2; 60use constant TRUST_ULTIMATE => 3; 61 62use Carp; 63use POSIX qw(); 64use Symbol; 65use Fcntl; 66 67sub parse_trust { 68 for (shift) { 69 /ULTIMATE/ && do { return TRUST_ULTIMATE; }; 70 /FULLY/ && do { return TRUST_FULLY; }; 71 /MARGINAL/ && do { return TRUST_MARGINAL; }; 72 /NEVER/ && do { return TRUST_NEVER; }; 73 # Default 74 return TRUST_UNDEFINED; 75 } 76} 77 78sub options($;$) { 79 my $self = shift; 80 $self->{cmd_options} = shift if ( $_[0] ); 81 $self->{cmd_options}; 82} 83 84sub command($;$) { 85 my $self = shift; 86 $self->{command} = shift if ( $_[0] ); 87 $self->{command}; 88} 89 90sub args($;$) { 91 my $self = shift; 92 $self->{args} = shift if ( $_[0] ); 93 $self->{args}; 94} 95 96sub cmdline($) { 97 my $self = shift; 98 my $args = [ $self->{gnupg_path} ]; 99 100 # Default options 101 push @$args, "--no-tty" unless $self->{trace}; 102 push @$args, "--no-greeting", "--yes", "--status-fd", fileno $self->{status_fd}, 103 "--command-fd", fileno $self->{command_fd}; 104 105 # Check for homedir and options file 106 push @$args, "--homedir", $self->{homedir} if $self->{homedir}; 107 push @$args, "--options", $self->{options} if $self->{options}; 108 109 # Command options 110 push @$args, @{ $self->options }; 111 112 113 # Command and arguments 114 push @$args, "--" . $self->command; 115 push @$args, @{ $self->args }; 116 117 return $args; 118} 119 120sub end_gnupg($) { 121 my $self = shift; 122 123 print STDERR "GnuPG: closing status fd " . fileno ($self->{status_fd}) 124 . "\n" 125 if $self->{trace}; 126 127 close $self->{status_fd} 128 or croak "error while closing pipe: $!\n"; 129 130 print STDERR "GnuPG: closing command fd " . fileno ($self->{command_fd}) 131 . "\n" 132 if $self->{trace}; 133 134 close $self->{command_fd} 135 or croak "error while closing pipe: $!\n"; 136 137 waitpid $self->{gnupg_pid}, 0 138 or croak "error while waiting for gpg: $!\n"; 139 140 141 for ( qw(protocol gnupg_pid command options args status_fd command_fd 142 input output next_status ) ) 143 { 144 delete $self->{$_}; 145 } 146 147} 148 149sub abort_gnupg($$) { 150 my ($self,$msg) = @_; 151 152 # Signal our child that it is the end 153 if ($self->{gnupg_pid} && kill 0 => $self->{gnupg_pid} ) { 154 kill INT => $self->{gnupg_pid}; 155 } 156 157 $self->end_gnupg; 158 159 confess ( $msg ); 160} 161 162# Used to push back status information 163sub next_status($$$) { 164 my ($self,$cmd,$arg) = @_; 165 166 $self->{next_status} = [$cmd,$arg]; 167} 168 169sub read_from_status($) { 170 my $self = shift; 171 # Check if a status was pushed back 172 if ( $self->{next_status} ) { 173 my $status = $self->{next_status}; 174 $self->{next_status} = undef; 175 return @$status; 176 } 177 178 print STDERR "GnuPG: reading from status fd " . fileno ($self->{status_fd}) . "\n" if $self->{trace}; 179 180 my $fd = $self->{status_fd}; 181 local $/ = "\n"; # Just to be sure 182 my $line = <$fd>; 183 unless ($line) { 184 print STDERR "GnuPG: got from status fd: EOF" if $self->{trace}; 185 return (); 186 } 187 188 print STDERR "GnuPG: got from status fd: $line" if $self->{trace}; 189 190 my ( $cmd,$arg ) = $line =~ /\[GNUPG:\] (\w+) ?(.+)?$/; 191 $self->abort_gnupg( "error communicating with gnupg: bad status line: $line\n" ) unless $cmd; 192 print STDERR "GnuPG: Parsed as " . $cmd . " - " . $arg . "\n" if $self->{trace}; 193 return wantarray ? ( $cmd, $arg ) : $cmd; 194} 195 196sub run_gnupg($) { 197 my $self = shift; 198 199 my $fd = gensym; 200 my $wfd = gensym; 201 202 my $crfd = gensym; # command read and write file descriptors 203 my $cwfd = gensym; 204 205 pipe $fd, $wfd 206 or croak ( "error creating status pipe: $!\n" ); 207 my $old = select $wfd; $| = 1; # Unbuffer 208 select $old; 209 210 pipe $crfd, $cwfd 211 or croak ( "error creating command pipe: $!\n" ); 212 $old = select $cwfd; $| = 1; # Unbuffer 213 select $old; 214 215 # Keep pipe open after close 216 fcntl( $fd, F_SETFD, 0 ) 217 or croak "error removing close on exec flag: $!\n" ; 218 fcntl( $wfd, F_SETFD, 0 ) 219 or croak "error removing close on exec flag: $!\n" ; 220 fcntl( $crfd, F_SETFD, 0 ) 221 or croak "error removing close on exec flag: $!\n" ; 222 fcntl( $cwfd, F_SETFD, 0 ) 223 or croak "error removing close on exec flag: $!\n" ; 224 225 my $pid = fork; 226 croak( "error forking: $!" ) unless defined $pid; 227 if ( $pid ) { 228 # Parent 229 close $wfd; 230 231 $self->{status_fd} = $fd; 232 $self->{gnupg_pid} = $pid; 233 $self->{command_fd} = $cwfd; 234 235 } else { 236 # Child 237 $self->{status_fd} = $wfd; 238 $self->{command_fd} = $crfd; 239 240 my $cmdline = $self->cmdline; 241 unless ( $self->{trace} ) { 242 open (STDERR, "> /dev/null" ) 243 or die "can't redirect stderr to /dev/null: $!\n"; 244 } 245 246 # This is where we grab the data 247 if ( ref $self->{input} && defined fileno $self->{input} ) { 248 open ( STDIN, "<&" . fileno $self->{input} ) 249 or die "error setting up data input: $!\n"; 250 } elsif ( $self->{input} && -t STDIN) { 251 open ( STDIN, $self->{input} ) 252 or die "error setting up data input: $!\n"; 253 } elsif ( $self->{input} ) { 254 push(@{$cmdline}, $self->{input}); 255 }# Defaults to stdin 256 257 # This is where the output goes 258 if ( ref $self->{output} && defined fileno $self->{output} ) { 259 open ( STDOUT, ">&" . fileno $self->{output} ) 260 or die "can't redirect stdout to proper output fd: $!\n"; 261 } elsif ( $self->{output} && -t STDOUT ) { 262 open ( STDOUT, ">".$self->{output} ) 263 or die "can't open $self->{output} for output: $!\n"; 264 } elsif ( $self->{output} ) { 265 my $gpg = shift(@{$cmdline}); 266 unshift(@{$cmdline}, '--output', $self->{output}); 267 unshift(@{$cmdline}, $gpg); 268 } # Defaults to stdout 269 270 # Close all open file descriptors except STDIN, STDOUT, STDERR 271 # and the status filedescriptor. 272 # 273 # This is needed for the tie interface which opens pipes which 274 # some ends must be closed in the child. 275 # 276 # Besides this is just plain good hygiene 277 my $max_fd = POSIX::sysconf( &POSIX::_SC_OPEN_MAX ) || 256; 278 foreach my $f ( 3 .. $max_fd ) { 279 next if $f == fileno $self->{status_fd}; 280 next if $f == fileno $self->{command_fd}; 281 POSIX::close( $f ); 282 } 283 284 print STDERR 'GnuPG: executing `' 285 . join( ' ', @{$cmdline} ) . '`' if $self->{trace}; 286 287 exec ( @$cmdline ) 288 or CORE::die "can't exec gnupg: $!\n"; 289 } 290} 291 292sub cpr_maybe_send($$$) { 293 ($_[0])->cpr_send( @_[1, $#_], 1); 294} 295 296 297sub cpr_send($$$;$) { 298 my ($self,$key,$value, $optional) = @_; 299 my $fd = $self->{command_fd}; 300 301 my ( $cmd, $arg ) = $self->read_from_status; 302 unless ( defined $cmd && $cmd =~ /^GET_/) { 303 $self->abort_gnupg( "protocol error: expected GET_XXX got $cmd\n" ) 304 unless $optional; 305 $self->next_status( $cmd, $arg ); 306 return; 307 } 308 309 unless ( $arg eq $key ) { 310 $self->abort_gnupg ( "protocol error: expected key $key got $arg\n" ) 311 unless $optional; 312 return; 313 } 314 315 print STDERR "GnuPG: writing to command fd " . fileno ($fd) . ": $value\n" if $self->{trace}; 316 317 print $fd $value . "\n"; 318 319 ( $cmd, $arg ) = $self->read_from_status; 320 unless ( defined $cmd && $cmd =~ /^GOT_IT/) { 321 $self->next_status( $cmd, $arg ); 322 } 323} 324 325 326sub send_passphrase($$) { 327 my ($self,$passwd) = @_; 328 329 # GnuPG should now tell us that it needs a passphrase 330 my $cmd = $self->read_from_status; 331 # Skip UserID hint 332 $cmd = $self->read_from_status if ( $cmd =~ /USERID_HINT/ ); 333 if ($cmd =~ /GOOD_PASSPHRASE/) { # This means we didnt need a passphrase 334 $self->next_status($cmd); # We push this back on for read_from_status 335 return; 336 } 337 $self->abort_gnupg( "Protocol error: expected NEED_PASSPHRASE.* got $cmd\n") 338 unless $cmd =~ /NEED_PASSPHRASE/; 339 $self->cpr_send( "passphrase.enter", $passwd ); 340 unless ( $passwd ) { 341 my $cmd = $self->read_from_status; 342 $self->abort_gnupg( "Protocol error: expected MISSING_PASSPHRASE got $cmd\n" ) 343 unless $cmd eq "MISSING_PASSPHRASE"; 344 } 345} 346 347sub new($%) { 348 my $proto = shift; 349 my $class = ref $proto || $proto; 350 351 my %args = @_; 352 353 my $self = {}; 354 if ($args{homedir}) { 355 croak ( "Invalid home directory: $args{homedir}\n") 356 unless -d $args{homedir} && -x _; 357 $self->{homedir} = $args{homedir}; 358 } 359 if ($args{options}) { 360 croak ( "Invalid options file: $args{options}\n") 361 unless -r $args{options}; 362 $self->{options} = $args{options}; 363 } 364 if ( $args{gnupg_path} ) { 365 croak ( "Invalid gpg path: $args{gnupg_path}\n") 366 unless -x $args{gnupg_path}; 367 $self->{gnupg_path} = $args{gnupg_path}; 368 } else { 369 my ($path) = grep { -x "$_/gpg" } split /:/, $ENV{PATH}; 370 croak ( "Couldn't find gpg in PATH ($ENV{PATH})\n" ) 371 unless $path; 372 $self->{gnupg_path} = "$path/gpg"; 373 } 374 $self->{trace} = $args{trace} ? 1 : 0; 375 376 bless $self, $class; 377} 378 379sub DESTROY { 380 my $self = shift; 381 # Signal our child that it is the end 382 if ($self->{gnupg_pid} && kill 0 => $self->{gnupg_pid} ) { 383 kill INT => $self->{gnupg_pid}; 384 } 385} 386 387sub gen_key($%) { 388 my ($self,%args) = @_; 389 my $cmd; 390 my $arg; 391 392 my $algo = $args{algo}; 393 $algo ||= RSA_RSA; 394 395 my $size = $args{size}; 396 $size ||= 1024; 397 croak ( "Keysize is too small: $size" ) if $size < 768; 398 croak ( "Keysize is too big: $size" ) if $size > 2048; 399 400 my $expire = $args{valid}; 401 $expire ||= 0; 402 403 my $passphrase = $args{passphrase} || ""; 404 my $name = $args{name}; 405 406 croak "Missing key name\n" unless $name; 407 croak "Invalid name: $name\n" 408 unless $name =~ /^\s*[^0-9\<\(\[\]\)\>][^\<\(\[\]\)\>]+$/; 409 410 my $email = $args{email}; 411 if ( $email ) { 412 croak "Invalid email address: $email" 413 unless $email =~ /^\s* # Whitespace are okay 414 [a-zA-Z0-9_-] # Doesn't start with a dot 415 [a-zA-Z0-9_.-]* 416 \@ # Contains at most one at 417 [a-zA-Z0-9_.-]+ 418 [a-zA-Z0-9_-] # Doesn't end in a dot 419 /x 420 && $email !~ /\.\./; 421 } else { 422 $email = ""; 423 } 424 425 my $comment = $args{comment}; 426 if ( $comment ) { 427 croak "Invalid characters in comment" if $comment =~ /[()]/; 428 } else { 429 $comment = ""; 430 } 431 432 $self->command( "gen-key" ); 433 $self->options( [] ); 434 $self->args( [] ); 435 436 $self->run_gnupg; 437 438 $self->cpr_send("keygen.algo", $algo ); 439# if ( $algo == ELGAMAL ) { 440# # Shitty interactive program, yes I'm sure. 441# # I'm a program, I can't change my mind now. 442# $self->cpr_send( "keygen.algo.elg_se", 1 ) 443# } 444 445 $self->cpr_send( "keygen.size", $size ); 446 $self->cpr_send( "keygen.valid", $expire ); 447 $self->cpr_send( "keygen.name", $name ); 448 $self->cpr_send( "keygen.email", $email ); 449 $self->cpr_send( "keygen.comment", $comment ); 450 451 $self->send_passphrase( $passphrase ); 452 453 $self->end_gnupg; 454 455 # Woof. We should now have a generated key ! 456} 457 458sub import_keys($%) { 459 my ($self,%args) = @_; 460 461 462 $self->command( "import" ); 463 $self->options( [] ); 464 465 my $count; 466 if ( ref $args{keys} ) { 467 $self->args( $args{keys} ); 468 } else { 469 # Only one file to import 470 $self->{input} = $args{keys}; 471 $self->args( [] ); 472 } 473 474 $self->run_gnupg; 475 FILE: 476 my $num_files = ref $args{keys} ? @{$args{keys}} : 1; 477 my ($cmd,$arg); 478 479 # We will see one IMPORTED for each key that is imported 480 KEY: 481 while ( 1 ) { 482 ($cmd,$arg) = $self->read_from_status; 483 last KEY unless $cmd =~ /IMPORTED/; 484 $count++ 485 } 486 487 # We will see one IMPORT_RES for all files processed 488 $self->abort_gnupg ( "protocol error expected IMPORT_OK got $cmd\n" ) 489 unless $cmd =~ /IMPORT_OK/; 490 $self->end_gnupg; 491 492 # We return the number of imported keys 493 return $count; 494} 495 496sub export_keys($%) { 497 my ($self,%args) = @_; 498 499 my $options = []; 500 push @$options, "--armor" if $args{armor}; 501 502 $self->{output} = $args{output}; 503 504 my $keys = []; 505 if ( $args{keys}) { 506 push @$keys, 507 ref $args{keys} ? @{$args{keys}} : $args{keys}; 508 } 509 510 if ( $args{secret} ) { 511 $self->command( "export-secret-keys" ); 512 } elsif ( $args{all} ){ 513 $self->command( "export-all" ); 514 } else { 515 $self->command( "export" ); 516 } 517 $self->options( $options ); 518 $self->args( $keys ); 519 520 $self->run_gnupg; 521 $self->end_gnupg; 522} 523 524sub encrypt($%) { 525 my ($self,%args) = @_; 526 527 my $options = []; 528 croak ( "no recipient specified\n" ) 529 unless $args{recipient} or $args{symmetric}; 530 531 for my $recipient ( 532 ref $args{recipient} eq 'ARRAY' 533 ? @{ $args{recipient} } 534 : $args{recipient} ) { 535 $recipient =~ s/ /\ /g; # Escape spaces in the recipient. This fills some strange edge case 536 push @$options, "--recipient" => $recipient; 537 } 538 539 push @$options, "--sign" if $args{sign}; 540 croak ( "can't sign an symmetric encrypted message\n" ) 541 if $args{sign} and $args{symmetric}; 542 543 my $passphrase = $args{passphrase} || ""; 544 545 push @$options, "--armor" if $args{armor}; 546 push @$options, "--local-user", $args{"local-user"} 547 if defined $args{"local-user"}; 548 549 $self->{input} = $args{plaintext} || $args{input}; 550 $self->{output} = $args{output}; 551 if ( $args{symmetric} ) { 552 $self->command( "symmetric" ); 553 } else { 554 $self->command( "encrypt" ); 555 } 556 $self->options( $options ); 557 $self->args( [] ); 558 559 $self->run_gnupg; 560 561 # Unless we decided to sign or are using symmetric cipher, we are done 562 if ( $args{sign} or $args{symmetric} ) { 563 $self->send_passphrase( $passphrase ); 564 if ( $args{sign} ) { 565 my ($cmd,$line) = $self->read_from_status; 566 $self->abort_gnupg( "invalid passphrase - $cmd\n" ) 567 unless $cmd =~ /GOOD_PASSPHRASE/; 568 } 569 } 570 571 # It is possible that this key has no assigned trust value. 572 # Assume the caller knows what he is doing. 573 $self->cpr_maybe_send( "untrusted_key.override", 'y' ); 574 575 $self->end_gnupg unless $args{tie_mode}; 576} 577 578sub sign($%) { 579 my ($self,%args) = @_; 580 581 my $options = []; 582 my $passphrase = $args{passphrase} || ""; 583 584 push @$options, "--armor" if $args{armor}; 585 push @$options, "--local-user", $args{"local-user"} 586 if defined $args{"local-user"}; 587 588 $self->{input} = $args{plaintext} || $args{input}; 589 $self->{output} = $args{output}; 590 if ( $args{clearsign} ) { 591 $self->command( "clearsign" ); 592 } elsif ( $args{"detach-sign"}) { 593 $self->command( "detach-sign" ); 594 } else { 595 $self->command( "sign" ); 596 } 597 $self->options( $options ); 598 $self->args( [] ); 599 600 $self->run_gnupg; 601 602 # We need to unlock the private key 603 $self->send_passphrase( $passphrase ); 604 my ($cmd,$line) = $self->read_from_status; 605 $self->abort_gnupg( "invalid passphrase - $cmd\n" ) 606 unless $cmd =~ /GOOD_PASSPHRASE/; 607 608 $self->end_gnupg unless $args{tie_mode}; 609} 610 611sub clearsign($%) { 612 my $self = shift; 613 $self->sign( @_, clearsign => 1 ); 614} 615 616 617sub check_sig($;$$) { 618 my ( $self, $cmd, $arg) = @_; 619 620 # Our caller may already have grabbed the first line of 621 # signature reporting. 622 ($cmd,$arg) = $self->read_from_status unless ( $cmd ); 623 624 # Ignore patent warnings. 625 ( $cmd, $arg ) = $self->read_from_status() 626 if ( $cmd =~ /RSA_OR_IDEA/ ); 627 628 # Ignore automatic key imports 629 ( $cmd, $arg ) = $self->read_from_status() 630 if ( $cmd =~ /IMPORTED/ ); 631 632 ( $cmd, $arg ) = $self->read_from_status() 633 if ( $cmd =~ /IMPORT_OK/ ); 634 635 ( $cmd, $arg ) = $self->read_from_status() 636 if ( $cmd =~ /IMPORT_RES/ ); 637 638 $self->abort_gnupg( "invalid signature from ", $arg =~ /[^ ](.+)/, "\n" ) 639 if ( $cmd =~ /BADSIG/); 640 641 if ( $cmd =~ /ERRSIG/) 642 { 643 my ($keyid, $key_algo, $digest_algo, $sig_class, $timestamp, $rc) 644 = split ' ', $arg; 645 if ($rc == 9) 646 { 647 ($cmd, $arg) = $self->read_from_status(); 648 $self->abort_gnupg( "no public key $keyid" ); 649 } 650 $self->abort_gnupg( "error verifying signature from $keyid" ) 651 } 652 653 $self->abort_gnupg ( "protocol error: expected SIG_ID" ) 654 unless $cmd =~ /SIG_ID/; 655 my ( $sigid, $date, $time ) = split /\s+/, $arg; 656 657 ( $cmd, $arg ) = $self->read_from_status; 658 $self->abort_gnupg ( "protocol error: expected GOODSIG" ) 659 unless $cmd =~ /GOODSIG/; 660 my ( $keyid, $name ) = split /\s+/, $arg, 2; 661 662 ( $cmd, $arg ) = $self->read_from_status; 663 my $policy_url = undef; 664 if ( $cmd =~ /POLICY_URL/ ) { 665 $policy_url = $arg; 666 ( $cmd, $arg ) = $self->read_from_status; 667 } 668 669 $self->abort_gnupg ( "protocol error: expected VALIDSIG" ) 670 unless $cmd =~ /VALIDSIG/; 671 my ( $fingerprint ) = split /\s+/, $arg, 2; 672 673 ( $cmd, $arg ) = $self->read_from_status; 674 $self->abort_gnupg ( "protocol error: expected TRUST*" ) 675 unless $cmd =~ /TRUST/; 676 my ($trust) = parse_trust( $cmd ); 677 678 return { sigid => $sigid, 679 date => $date, 680 timestamp => $time, 681 keyid => $keyid, 682 user => $name, 683 fingerprint => $fingerprint, 684 trust => $trust, 685 policy_url => $policy_url, 686 }; 687} 688 689sub verify($%) { 690 my ($self,%args) = @_; 691 692 croak ( "missing signature argument\n" ) unless $args{signature}; 693 my $files = []; 694 if ( $args{file} ) { 695 croak ( "detached signature must be in a file\n" ) 696 unless -f $args{signature}; 697 push @$files, $args{signature}, 698 ref $args{file} ? @{$args{file}} : $args{file}; 699 } else { 700 $self->{input} = $args{signature}; 701 } 702 $self->command( "verify" ); 703 $self->options( [] ); 704 $self->args( $files ); 705 706 $self->run_gnupg; 707 my $sig = $self->check_sig; 708 709 $self->end_gnupg; 710 711 return $sig; 712} 713 714sub decrypt($%) { 715 my $self = shift; 716 my %args = @_; 717 718 $self->{input} = $args{ciphertext} || $args{input}; 719 $self->{output} = $args{output}; 720 $self->command( "decrypt" ); 721 $self->options( [] ); 722 $self->args( [] ); 723 724 $self->run_gnupg; 725 726 return $self->decrypt_postwrite( @_ ) unless $args{tie_mode}; 727} 728 729sub decrypt_postwrite($%) { 730 my ($self,%args) = @_; 731 732 my $passphrase = $args{passphrase} || ""; 733 734 my ( $cmd, $arg ); 735 unless ( $args{symmetric} ) { 736 ( $cmd, $arg ) = $self->read_from_status; 737 $self->abort_gnupg ( "protocol error: expected ENC_TO got $cmd: \n" ) 738 unless $cmd =~ /ENC_TO/; 739 } 740 741 $self->send_passphrase( $passphrase ); 742 ($cmd,$arg) = $self->read_from_status; 743 744 $self->abort_gnupg ( "invalid passphrase - $cmd\n" ) 745 if $cmd =~ /BAD_PASSPHRASE/; 746 747 my $sig = undef; 748 749 if ( ! $args{symmetric} ) { 750 $self->abort_gnupg ( "protocol error: expected GOOD_PASSPHRASE got $cmd: \n" ) 751 unless $cmd =~ /GOOD_PASSPHRASE/; 752 753 $sig = $self->decrypt_postread() unless $args{tie_mode}; 754 } else { 755 # gnupg 1.0.2 adds this status message 756 ( $cmd, $arg ) = $self->read_from_status() if $cmd =~ /BEGIN_DECRYPTION/; 757 # gnupg 1.4.12 adds this status message 758 ( $cmd, $arg ) = $self->read_from_status() if $cmd =~ /DECRYPTION_INFO/; 759 760 $self->abort_gnupg( "invalid passphrase - $cmd" ) unless $cmd =~ /PLAINTEXT/; 761 } 762 763 $self->end_gnupg() unless $args{tie_mode}; 764 765 return $sig ? $sig : 1; 766} 767 768sub decrypt_postread($) { 769 my $self = shift; 770 771 my @cmds; 772 # gnupg 1.0.2 adds this status message 773 my ( $cmd, $arg ) = $self->read_from_status; 774 push @cmds, $cmd; 775 776 if ($cmd =~ /BEGIN_DECRYPTION/) { 777 ( $cmd, $arg ) = $self->read_from_status(); 778 push @cmds, $cmd; 779 }; 780 781 my $sig = undef; 782 while (defined $cmd && !($cmd =~ /DECRYPTION_OKAY/)) { 783 if ( $cmd =~ /SIG_ID/ ) { 784 $sig = $self->check_sig( $cmd, $arg ); 785 } 786 ( $cmd, $arg ) = $self->read_from_status(); 787 push @cmds, $cmd if defined $cmd; 788 }; 789 790 my $cmds = join ', ', @cmds; 791 $self->abort_gnupg( "protocol error: expected DECRYPTION_OKAY but never got it (all I saw was: $cmds): \n" ) 792 unless $cmd =~ /DECRYPTION_OKAY/; 793 794 return $sig ? $sig : 1; 795} 796 7971; 798__END__ 799 800=pod 801 802=head1 NAME 803 804GnuPG - Perl module interface to the GNU Privacy Guard (v1.x.x series) 805 806=head1 SYNOPSIS 807 808 use GnuPG qw( :algo ); 809 810 my $gpg = new GnuPG(); 811 812 $gpg->encrypt( plaintext => "file.txt", output => "file.gpg", 813 armor => 1, sign => 1, 814 passphrase => $secret ); 815 816 $gpg->decrypt( ciphertext => "file.gpg", output => "file.txt" ); 817 818 $gpg->clearsign( plaintext => "file.txt", output => "file.txt.asc", 819 passphrase => $secret, armor => 1, 820 ); 821 822 $gpg->verify( signature => "file.txt.asc", file => "file.txt" ); 823 824 $gpg->gen_key( name => "Joe Blow", comment => "My GnuPG key", 825 passphrase => $secret, 826 ); 827 828=head1 DESCRIPTION 829 830GnuPG is a perl interface to the GNU Privacy Guard. It uses the 831shared memory coprocess interface that gpg provides for its 832wrappers. It tries its best to map the interactive interface of 833the gpg to a more programmatic model. 834 835=head1 API OVERVIEW 836 837The API is accessed through methods on a GnuPG object which is 838a wrapper around the B<gpg> program. All methods takes their 839argument using named parameters, and errors are returned by 840throwing an exception (using croak). If you wan't to catch 841errors you will have to use eval. 842 843When handed in a file handle for input or output parameters 844on many of the functions, the API attempts to tie that 845handle to STDIN and STDOUT. In certain persistent environments 846(particularly a web environment), this will not work. This 847problem can be avoided by passing in file names to all 848relevant parameters rather than a Perl file handle. 849 850There is also a tied file handle interface which you may find more 851convenient for encryption and decryption. See GnuPG::Tie(3) for details. 852 853=head1 CONSTRUCTOR 854 855=head2 new ( [params] ) 856 857You create a new GnuPG wrapper object by invoking its new method. 858(How original !). The module will try to finds the B<gpg> program 859in your path and will croak if it can't find it. Here are the 860parameters that it accepts : 861 862=over 863 864=item gnupg_path 865 866Path to the B<gpg> program. 867 868=item options 869 870Path to the options file for B<gpg>. If not specified, it will use 871the default one (usually F<~/.gnupg/options>). 872 873=item homedir 874 875Path to the B<gpg> home directory. This is the directory that contains 876the default F<options> file, the public and private key rings as well 877as the trust database. 878 879=item trace 880 881If this variable is set to true, B<gpg> debugging output will be sent 882to stderr. 883 884=back 885 886 Example: my $gpg = new GnuPG(); 887 888=head1 METHODS 889 890=head2 gen_key( [params] ) 891 892This methods is used to create a new gpg key pair. The methods croaks 893if there is an error. It is a good idea to press random keys on the 894keyboard while running this methods because it consumes a lot of 895entropy from the computer. Here are the parameters it accepts : 896 897=over 898 899=item algo 900 901This is the algorithm use to create the key. Can be I<DSA_ELGAMAL>, 902I<DSA>, I<RSA_RSA> or I<RSA>. 903It defaults to I<DSA_ELGAMAL>. To import 904those constant in your name space, use the I<:algo> tag. 905 906=item size 907 908The size of the public key. Defaults to 1024. Cannot be less than 909768 bits, and keys longer than 2048 are also discouraged. (You *DO* 910know that your monitor may be leaking sensitive information ;-). 911 912=item valid 913 914How long the key is valid. Defaults to 0 or never expire. 915 916=item name 917 918This is the only mandatory argument. This is the name that will used 919to construct the user id. 920 921=item email 922 923Optional email portion of the user id. 924 925=item comment 926 927Optional comment portion of the user id. 928 929=item passphrase 930 931The passphrase that will be used to encrypt the private key. Optional 932but strongly recommended. 933 934=back 935 936 Example: $gpg->gen_key( algo => DSA_ELGAMAL, size => 1024, 937 name => "My name" ); 938 939=head2 import_keys( [params] ) 940 941Import keys into the GnuPG private or public keyring. The method 942croaks if it encounters an error. It returns the number of 943keys imported. Parameters : 944 945=over 946 947=item keys 948 949Only parameter and mandatory. It can either be a filename or a 950reference to an array containing a list of files that will be 951imported. 952 953=back 954 955 Example: $gpg->import_keys( keys => [ qw( key.pub key.sec ) ] ); 956 957=head2 export_keys( [params] ) 958 959Exports keys from the GnuPG keyrings. The method croaks if it 960encounters an error. Parameters : 961 962=over 963 964=item keys 965 966Optional argument that restricts the keys that will be exported. 967Can either be a user id or a reference to an array of userid that 968specifies the keys to be exported. If left unspecified, all keys 969will be exported. 970 971=item secret 972 973If this argument is to true, the secret keys rather than the public 974ones will be exported. 975 976=item all 977 978If this argument is set to true, all keys (even those that aren't 979OpenPGP compliant) will be exported. 980 981=item output 982 983This argument specifies where the keys will be exported. Can be either 984a file name or a reference to a file handle. If not specified, the 985keys will be exported to stdout. 986 987=item armor 988 989Set this parameter to true, if you want the exported keys to be ASCII 990armored. 991 992=back 993 994 Example: $gpg->export_keys( armor => 1, output => "keyring.pub" ); 995 996 997=head2 encrypt( [params] ) 998 999This method is used to encrypt a message, either using assymetric 1000or symmetric cryptography. The methods croaks if an error is 1001encountered. Parameters: 1002 1003=over 1004 1005=item plaintext 1006 1007This argument specifies what to encrypt. It can be either a filename 1008or a reference to a file handle. If left unspecified, STDIN will be 1009encrypted. 1010 1011=item output 1012 1013This optional argument specifies where the ciphertext will be output. 1014It can be either a file name or a reference to a file handle. If left 1015unspecified, the ciphertext will be sent to STDOUT. 1016 1017=item armor 1018 1019If this parameter is set to true, the ciphertext will be ASCII 1020armored. 1021 1022=item symmetric 1023 1024If this parameter is set to true, symmetric cryptography will be 1025used to encrypt the message. You will need to provide a I<passphrase> 1026parameter. 1027 1028=item recipient 1029 1030If not using symmetric cryptography, you will have to provide this 1031parameter. It should contains the userid of the intended recipient of 1032the message. It will be used to look up the key to use to encrypt the 1033message. The parameter can also take an array ref, if you want to encrypt 1034the message for a group of recipients. 1035 1036=item sign 1037 1038If this parameter is set to true, the message will also be signed. You 1039will probably have to use the I<passphrase> parameter to unlock the 1040private key used to sign message. This option is incompatible with 1041the I<symmetric> one. 1042 1043=item local-user 1044 1045This parameter is used to specified the private key that will be used 1046to sign the message. If left unspecified, the default user will be 1047used. This option only makes sense when using the I<sign> option. 1048 1049=item passphrase 1050 1051This parameter contains either the secret passphrase for the symmetric 1052algorithm or the passphrase that should be used to decrypt the private 1053key. 1054 1055=back 1056 1057 Example: $gpg->encrypt( plaintext => file.txt, output => "file.gpg", 1058 sign => 1, passphrase => $secret 1059 ); 1060 1061=head2 sign( [params] ) 1062 1063This method is used create a signature for a file or stream of data. 1064This method croaks on errors. Parameters : 1065 1066=over 1067 1068=item plaintext 1069 1070This argument specifies what to sign. It can be either a filename 1071or a reference to a file handle. If left unspecified, the data read on 1072STDIN will be signed. 1073 1074=item output 1075 1076This optional argument specifies where the signature will be output. 1077It can be either a file name or a reference to a file handle. If left 1078unspecified, the signature will be sent to STDOUT. 1079 1080=item armor 1081 1082If this parameter is set to true, the signature will be ASCII armored. 1083 1084=item passphrase 1085 1086This parameter contains the secret that should be used to decrypt the 1087private key. 1088 1089=item local-user 1090 1091This parameter is used to specified the private key that will be used 1092to make the signature . If left unspecified, the default user will be 1093used. 1094 1095=item detach-sign 1096 1097If set to true, a digest of the data will be signed rather than 1098the whole file. 1099 1100=back 1101 1102 Example: $gpg->sign( plaintext => "file.txt", output => "file.txt.asc", 1103 armor => 1, 1104 ); 1105 1106=head2 clearsign( [params] ) 1107 1108This methods clearsign a message. The output will contains the original 1109message with a signature appended. It takes the same parameters as 1110the B<sign> method. 1111 1112=head2 verify( [params] ) 1113 1114This method verifies a signature against the signed message. The 1115methods croaks if the signature is invalid or an error is 1116encountered. If the signature is valid, it returns an hash with 1117the signature parameters. Here are the method's parameters : 1118 1119=over 1120 1121=item signature 1122 1123If the message and the signature are in the same file (i.e. a 1124clearsigned message), this parameter can be either a file name or a 1125reference to a file handle. If the signature doesn't follows the 1126message, than it must be the name of the file that contains the 1127signature. 1128 1129=item file 1130 1131This is a file name or a reference to an array of file names that 1132contains the signed data. 1133 1134=back 1135 1136When the signature is valid, here are the elements of the hash 1137that is returned by the method : 1138 1139=over 1140 1141=item sigid 1142 1143The signature id. This can be used to protect against replay 1144attack. 1145 1146=item date 1147 1148The data at which the signature has been made. 1149 1150=item timestamp 1151 1152The epoch timestamp of the signature. 1153 1154=item keyid 1155 1156The key id used to make the signature. 1157 1158=item user 1159 1160The userid of the signer. 1161 1162=item fingerprint 1163 1164The fingerprint of the signature. 1165 1166=item trust 1167 1168The trust value of the public key of the signer. Those are values that 1169can be imported in your namespace with the :trust tag. They are 1170(TRUST_UNDEFINED, TRUST_NEVER, TRUST_MARGINAL, TRUST_FULLY, TRUST_ULTIMATE). 1171 1172=back 1173 1174 Example : my $sig = $gpg->verify( signature => "file.txt.asc", 1175 file => "file.txt" ); 1176 1177=head2 decrypt( [params] ) 1178 1179This method decrypts an encrypted message. It croaks, if there is an 1180error while decrypting the message. If the message was signed, this 1181method also verifies the signature. If decryption is sucessful, the 1182method either returns the valid signature parameters if present, or 1183true. Method parameters : 1184 1185=over 1186 1187=item ciphertext 1188 1189This optional parameter contains either the name of the file 1190containing the ciphertext or a reference to a file handle containing 1191the ciphertext. If not present, STDIN will be decrypted. 1192 1193=item output 1194 1195This optional parameter determines where the plaintext will be stored. 1196It can be either a file name or a reference to a file handle. If left 1197unspecified, the plaintext will be sent to STDOUT. 1198 1199=item symmetric 1200 1201This should be set to true, if the message is encrypted using 1202symmetric cryptography. 1203 1204=item passphrase 1205 1206The passphrase that should be used to decrypt the message (in the case 1207of a message encrypted using a symmetric cipher) or the secret that 1208will unlock the private key that should be used to decrypt the 1209message. 1210 1211=back 1212 1213 Example: $gpg->decrypt( ciphertext => "file.gpg", output => "file.txt" 1214 passphrase => $secret ); 1215 1216=head1 BUGS AND LIMITATIONS 1217 1218This module doesn't work (yet) with the v2 branch of GnuPG. 1219 1220=head1 AUTHOR 1221 1222Francis J. Lacoste <francis.lacoste@Contre.COM> 1223 1224=head1 COPYRIGHT 1225 1226Copyright (c) 1999,2000 iNsu Innovations. Inc. 1227Copyright (c) 2001 Francis J. Lacoste 1228 1229This program is free software; you can redistribute it and/or modify 1230it under the terms of the GNU General Public License as published by 1231the Free Software Foundation; either version 2 of the License, or 1232(at your option) any later version. 1233 1234=head1 SEE ALSO 1235 1236L<GnuPG::Tie> 1237 1238Alternative module: L<GnuPG::Interface> 1239 1240gpg(1) 1241 1242=cut 1243