Platon Technologies
not logged in Login Registration
EnglishSlovak
open source software development celebrating 10 years of open source development! Friday, October 16, 2026
[BACK] [TXT][DIR] Up to [Platon] / scripts / perl / mail-gnupg

Diff for scripts/perl/mail-gnupg/mail-gnupg-encrypt.pl between version 1.1 and 1.2

version 1.1, 2005/01/13 17:07:15 version 1.2, 2005/01/15 02:19:28
Line 1 
Line 1 
 #!/usr/bin/perl  #!/usr/bin/perl -w
   
 #  #
 # mail-gnupg-encrypt.pl - encrypt received mail with  # mail-gnupg-encrypt.pl - encrypt received mail with
Line 13 
Line 13 
 # Changelog:  # Changelog:
 # 2005-01-13 - created  # 2005-01-13 - created
 #  #
   #
   # Keywords: mail, email, protected email, encryted email,
   #           GnuPG, GPG, PGP, encryption, procmail,
   #           mail filter, procmailrc, formail, security
   #
   # http://www.faqs.org/rfcs/rfc2015.html
   # http://www.faqs.org/rfcs/rfc3156.html
   #
   
   #
   # Usage: add following lines into your ~/.procmailrc
   #
   # :0fw:
   # | /path/to/mail-gnupg-encrypt.pl -r your@email.address.com
   #
   
 # $Platon$  # $Platon: scripts/perl/mail-gnupg/mail-gnupg-encrypt.pl,v 1.1 2005/01/13 17:07:15 rajo Exp $
   
 use strict;  use strict;
 use warnings;  use warnings;
Line 28  use vars qw (
Line 43  use vars qw (
         %conf $conf          %conf $conf
         $recipient          $recipient
         $cfgfile          $cfgfile
           $boundary $new_content_type $old_content_type
           $header_line $curr_header_key
 );  );
   
 sub help($;);  sub help($;);
Line 36  $| = 1;
Line 53  $| = 1;
   
 $VERSION        = do { my @r = (q$Revision$=~/\d+/g); sprintf "%d." . "%02d" x $#r, @r };  $VERSION        = do { my @r = (q$Revision$=~/\d+/g); sprintf "%d." . "%02d" x $#r, @r };
   
   $boundary = "mail-gnupg-ver-$VERSION-pid-$PID";
   $new_content_type = "Content-Type: multipart/encrypted; protocol=\"application/pgp-encrypted\";\n\tboundary=\"$boundary\"\n";
   $old_content_type = '';
   $header_line = '';
   $curr_header_key = '';
   
 $conf = AppConfig->new( # {{{  $conf = AppConfig->new( # {{{
         {          {
                 CASE => 1,                  CASE => 1,
Line 74  if (!defined($recipient) or $recipient e
Line 97  if (!defined($recipient) or $recipient e
 # }}}  # }}}
   
 tie *CIPHER, 'GnuPG::Tie::Encrypt', armor => 1, recipient => $recipient;  tie *CIPHER, 'GnuPG::Tie::Encrypt', armor => 1, recipient => $recipient;
   pipe(PARENT_RDR, CHILD_WTR) or die "Can't create pipe: $!\n";
   
 if (my $pid = fork) { # parent  if (my $pid = fork()) { # parent
         close (STDOUT);          close (STDOUT);
         while (<STDIN>) {          close (PARENT_RDR);
                 print CIPHER $_;          while (my $line = <STDIN>) {
                   if ($line =~ m/^$/o) { # end of header, print PGP header {{{
                           print CHILD_WTR $header_line;
                           print CHILD_WTR "\n\n--$boundary\n",
                           "Content-Type: application/pgp-encrypted\n",
                           "Content-Disposition: attachment\n\n",
                           "Version: 1\n\n",
                           "--$boundary\n",
                           "Content-Type: application/octet-stream\n",
                           "Content-Disposition: inline; filename=\"msg.asc\"\n\n";
                           last;
                   } # }}}
                   if ($line =~ m/^([a-zA-Z0-9-]+):\s+/o) { # {{{
                           if ($curr_header_key eq 'content-type') { # na predchadzajucom riadku bol content-type
                                   $header_line .= $line;
                                   $line = $new_content_type;
                           }
                           $curr_header_key = lc($1);
                           if ($curr_header_key eq 'content-type') {
                                   $old_content_type = $line;
                           }
                           else {
                                   print CHILD_WTR $line, $header_line; # one header line completes, ship it out
                                   $header_line = "";
                           }
                   } # }}}
                   else { # {{{
                           if ($curr_header_key eq 'content-type') {
                                   $old_content_type .= $line;
                                   #print "OLD = '$old_content_type'\n";
                           }
                           else {
                                   #print "XXX line ='$line'\n";
                                   $header_line .= $line;
                           }
                   } # }}}
           }
           close (CHILD_WTR);
   
           #
           # rest goes to the GnuPG
           #
           print CIPHER $old_content_type;
           print CIPHER "Content-Disposition: inline\n\n";
           # mail content goes to GnuPG withouth temporary file
           while (my $line = <STDIN>) {
                   print CIPHER $line;
         }          }
 }  }
 else { # child  else { # child
         die("Fork failed!: $!") unless defined $pid;          die("Fork failed!: $!") unless defined $pid;
         close (STDIN);          close (STDIN);
         while (<CIPHER>) {          close (CHILD_WTR);
           while (<PARENT_RDR>) { # first read header (unencrypted data from parent)
                 print;                  print;
         }          }
           while (<CIPHER>) { # read encrypted output from GnuPG
                   print;
           }
           # print terminator
           print "\n--$boundary--";
 }  }
   
 close CIPHER;  close CIPHER;
Line 100  sub help($;)
Line 176  sub help($;)
   
         print STDERR <<EOF;          print STDERR <<EOF;
 Usage:  Usage:
   
           -r
         --recipient             Define encrypted message recipient          --recipient             Define encrypted message recipient
   
         --cfg          --cfg
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
Platon Group <platon@platon.org> http://platon.org/
Copyright © 2002-2006 Platon Group
Site powered by Metafox CMS 		Go to Top