Platon Technologies
neprihlásený Prihlásiť Registrácia
SlovakEnglish
open source software development oslavujeme 10 rokov vývoja otvoreného softvéru! Nedeľa, 25. október 2026
[BACK] [TXT][DIR] Vyššie na [Platon] / scripts / perl / mail-gnupg

Rozdiely pre scripts/perl/mail-gnupg/mail-gnupg-encrypt.pl medzi verziami 1.1 a 1.2

verzia 1.1, 2005/01/13 17:07:15 verzia 1.2, 2005/01/15 02:19:28
Riadok 1 
Riadok 1 
 #!/usr/bin/perl  #!/usr/bin/perl -w
   
 #  #
 # mail-gnupg-encrypt.pl - encrypt received mail with  # mail-gnupg-encrypt.pl - encrypt received mail with
Riadok 13 
Riadok 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;
Riadok 28  use vars qw (
Riadok 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($;);
Riadok 36  $| = 1;
Riadok 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,
Riadok 74  if (!defined($recipient) or $recipient e
Riadok 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;
Riadok 100  sub help($;)
Riadok 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:
Odstranené z verzie1.1  
zmenené riadky
  Pridané vo verzii1.2
Platon Group <platon@platon.sk> http://platon.sk/
Copyright © 2002-2006 Platon Group
Stránka používa redakčný systém Metafox 		Na začiatok