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

   1 if {$argc != 3} {
   2     puts stderr "usage: ... headers-file body-file text-flag"
   3     exit 1
   4 }
   5
   6 set textflag [lindex $argv 2]
   7
   8 set hdrsfile [open [lindex $argv 0] w]
   9
  10 set mime ""
  11 foreach header [SafeTcl_getheaders] {
  12     if {[set name [string tolower [set field [lindex $header 0]]]] \
  13             == "mime-version"} {
  14         continue
  15     }
  16     if {[string first content- $name] == 0} {
  17         append mime "$field: [lindex $header 1]\n"
  18         continue
  19     }
  20
  21     puts $hdrsfile "$field: [lindex $header 1]"
  22 }
  23 puts $hdrsfile "MIME-Version: 1.0"
  24 if {$mime != ""} {
  25     puts $hdrsfile "Content-Type: application/pgp; format=mime\n"
  26 } elseif {$textflag == "T"} {
  27     puts $hdrsfile "Content-Type: text/pgp\n"
  28 } else {
  29     puts $hdrsfile "Content-Type: application/pgp\n"
  30 }
  31
  32 close $hdrsfile
  33
  34
  35 set bodyfile [open [lindex $argv 1] w]
  36
  37 if {$mime != ""} {
  38     puts $bodyfile "$mime"
  39 }
  40 puts -nonewline $bodyfile [SafeTcl_getbodyprop 1 value]
  41
  42 close $bodyfile
  43
  44
  45 if {[SafeTcl_getheader Resent-To] != ""} {
  46     set prefix Resent-
  47 } else {
  48     set prefix ""
  49 }
  50
  51 set addrs ""
  52 foreach header [list Reply-To From Sender To cc Bcc Dcc From] {
  53     foreach addr [SafeTcl_getaddrs [ SafeTcl_getheader $prefix$header]] {
  54         catch { if {[string first @ $addr] < 0} {
  55                     set addr [exec ali $addr]
  56                 }
  57                 set addr [SafeTcl_getaddrprop $addr address]
  58                 if {[lsearch -exact $addrs $addr] < 0} {
  59                     lappend addrs $addr
  60                 }
  61               }
  62     }
  63 }
  64
  65 if {[set from [SafeTcl_getheader From]] == ""} {
  66     set addr [id effective user]
  67 } else {
  68     set addr [lindex [SafeTcl_getaddrs $from] 0]
  69 }
  70 catch {
  71     if {[string first @ $addr] < 0} {
  72         set addr [exec ali $addr]
  73     }
  74     set addr [SafeTcl_getaddrprop $addr address]
  75 }
  76 if {[lsearch -exact $addrs $addr] < 0} {
  77     lappend addrs $addr
  78 }
  79
  80 puts stdout "$addrs -u $addr"