Added all of the MH sources, including RCS files, in
[mmh] / 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 @