diplodocus.org Git - nmh/blob - docs/historical/mh-6.8.5/support/general/RCS/pgped.tcl,v

   1 head    1.2;
   2 access;
   3 symbols;
   4 locks; strict;
   5 comment @# @;
   6
   7
   8 1.2
   9 date    95.12.06.21.00.46;      author jromine; state Exp;
  10 branches;
  11 next    1.1;
  12
  13 1.1
  14 date    95.12.06.20.57.55;      author jromine; state Exp;
  15 branches;
  16 next    ;
  17
  18
  19 desc
  20 @@
  21
  22
  23 1.2
  24 log
  25 @more pgp fixes from mtr
  26 @
  27 text
  28 @if {$argc != 3} {
  29     puts stderr "usage: ... headers-file body-file text-flag"
  30     exit 1
  31 }
  32
  33 set textflag [lindex $argv 2]
  34
  35 set hdrsfile [open [lindex $argv 0] w]
  36
  37 set mime ""
  38 foreach header [SafeTcl_getheaders] {
  39     if {[set name [string tolower [set field [lindex $header 0]]]] \
  40             == "mime-version"} {
  41         continue
  42     }
  43     if {[string first content- $name] == 0} {
  44         append mime "$field: [lindex $header 1]\n"
  45         continue
  46     }
  47
  48     puts $hdrsfile "$field: [lindex $header 1]"
  49 }
  50 puts $hdrsfile "MIME-Version: 1.0"
  51 if {$mime != ""} {
  52     puts $hdrsfile "Content-Type: application/pgp; format=mime\n"
  53 } elseif {$textflag == "T"} {
  54     puts $hdrsfile "Content-Type: text/pgp\n"
  55 } else {
  56     puts $hdrsfile "Content-Type: application/pgp\n"
  57 }
  58
  59 close $hdrsfile
  60
  61
  62 set bodyfile [open [lindex $argv 1] w]
  63
  64 if {$mime != ""} {
  65     puts $bodyfile "$mime"
  66 }
  67 puts -nonewline $bodyfile [SafeTcl_getbodyprop 1 value]
  68
  69 close $bodyfile
  70
  71
  72 if {[SafeTcl_getheader Resent-To] != ""} {
  73     set prefix Resent-
  74 } else {
  75     set prefix ""
  76 }
  77
  78 set addrs ""
  79 foreach header [list Reply-To From Sender To cc Bcc Dcc From] {
  80     foreach addr [SafeTcl_getaddrs [ SafeTcl_getheader $prefix$header]] {
  81         catch { if {[string first @@ $addr] < 0} {
  82                     set addr [exec ali $addr]
  83                 }
  84                 set addr [SafeTcl_getaddrprop $addr address]
  85                 if {[lsearch -exact $addrs $addr] < 0} {
  86                     lappend addrs $addr
  87                 }
  88               }
  89     }
  90 }
  91
  92 if {[set from [SafeTcl_getheader From]] == ""} {
  93     set addr [id effective user]
  94 } else {
  95     set addr [lindex [SafeTcl_getaddrs $from] 0]
  96 }
  97 catch {
  98     if {[string first @@ $addr] < 0} {
  99         set addr [exec ali $addr]
 100     }
 101     set addr [SafeTcl_getaddrprop $addr address]
 102 }
 103 if {[lsearch -exact $addrs $addr] < 0} {
 104     lappend addrs $addr
 105 }
 106
 107 puts stdout "$addrs -u $addr"
 108 @
 109
 110
 111 1.1
 112 log
 113 @Initial revision
 114 @
 115 text
 116 @d1 2
 117 a2 2
 118 if {$argc != 2} {
 119     puts stderr "usage: ... headers-file body-file"
 120 d6 1
 121 d26 2
 122 @