/[webpac]/trunk/openisis/tcl/md
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /trunk/openisis/tcl/md

Parent Directory Parent Directory | Revision Log Revision Log


Revision 239 - (show annotations)
Mon Mar 8 17:49:13 2004 UTC (20 years ago) by dpavlin
File size: 5315 byte(s)
including openisis 0.9.0 into webpac tree

1 #!/opt/bin/tspr
2 <%--
3 test Tcl server page
4 $Id: md,v 1.3 2003/06/10 11:02:47 kripke Exp $
5 --%><%!
6
7 package require mime;
8 namespace import ::mime::*;
9
10 # return list file from date subject size content-type
11 proc mscan file {
12 array set a {from {} date {} subject {} content-type {}}
13 set fid [open $file]
14 # for quick scan, ignore continuation lines and repeated headers
15 while {[gets $fid line]} {
16 if [regexp {^([\w\-]+):\s*(.*)} $line - key val] {
17 set a([string tolower $key]) $val
18 }
19 }
20 close $fid
21 list $file $a(from) $a(date) $a(subject) [file size $file] $a(content-type)
22 }
23
24 # return list file from date subject size encoding content params parts msg
25 proc mparse file {
26 set l [list $file]
27 set msg [initialize -file $file]
28 # mime want's whole messages
29
30 # headers
31 foreach key {From Date Subject} {
32 if [catch {getheader $msg $key} value] {
33 lappend l {}
34 } else {
35 lappend l $value
36 }
37 }
38 # properties (parsed content-* headers)
39 foreach key {size encoding content params parts} {
40 if [catch {getproperty $msg $key} value] {
41 lappend l {}
42 } else {
43 lappend l $value
44 }
45 }
46 lappend l $msg
47 return $l
48 }
49
50 %><%
51 # request standard tags
52 # -10 SCRIPT_NAME
53 # -11 PATH_INFO
54 # -12 REMOTE_USER
55 #
56 # request parameters
57 # 1 move destination (checkbox)
58 # 2 the ok button
59 # 3 write to
60 # 4 write subject
61 # 5 write body
62 #
63 global env
64 # foreach e [array names env] { ::puts stderr "$e\t$env($e)" }
65 ::puts stderr [request serialize]
66
67 set script [lindex [request get -10] 0]
68 set path [lindex [request get -11] 0]
69 set user [lindex [request get -12] 0]
70 set body [lindex [request get 5] 0]
71
72 if {"" == $user} return
73 set l [string length $user]
74 set fid [open /var/qmail/users/popasswd]
75 while {[gets $fid line]} {
76 if ![string match "$user:*" $line] continue
77 set upignh [split $line :]
78 set name [lindex $upignh 4]
79 set base [lindex $upignh 5]/Maildir
80 break
81 }
82 close $fid
83 cd $base
84 ::puts stderr [pwd]
85
86 if ![regexp {^/(\w+)(/\d+[\w.:,]*)?$} $path - dir file] {
87 set dir new
88 set file ""
89 set rel $script/
90 } elseif {"" == $file} {
91 set rel ""
92 } else {
93 set rel ../
94 }
95 if ![file isdirectory $dir] return
96 # scan for dirs
97 set dirs {} ;# dirs to list
98 set mvdirs {} ;# dirs to move to
99 foreach d [glob ???] {
100 if ![file isdirectory $d] continue
101 switch -- $d tmp {} default { lappend dirs $d }
102 switch -- $d new - tmp - uns - out - $dir {} default { lappend mvdirs $d }
103 }
104 if {"" != $body && [catch { # send
105 set to [lindex [request get 3] 0]
106 set subject [lindex [request get 4] 0]
107 if {"" == $to} { # get from message
108 set msg [initialize -file $dir$file]
109 if [catch {getheader $msg Reply-To} to] {
110 set to [getheader $msg From]
111 }
112 set to [lindex $to 0]
113 if {"" == $subject} {
114 set subject "Re: [lindex [getheader $msg Subject] 0]"
115 }
116 finalize $msg
117 }
118 set tim [clock seconds]
119 set gtf [clock format $tim -format %Y%m%d%H%M%S -gmt 1]
120 set rfc [clock format $tim -format {%a, %d %b %Y %H:%M:%S %Z}]
121 set fid [open uns/$gtf.[pid] w]
122 set msg [initialize -canonical text/plain \
123 -header [list Return-Path $name] \
124 -header [list From $name] \
125 -header [list To $to] \
126 -header [list Date $rfc] \
127 -header [list Subject $subject] \
128 -encoding quoted-printable \
129 -string $body ]
130 copymessage $msg $fid
131 close $fid
132 }]} {
133 global errorInfo
134 ::puts stderr $errorInfo
135 }
136 %><html>
137 <head>
138 </head>
139 <body>
140 <%"name%>/<%=dir%>
141 list:
142 <%
143 foreach d $dirs {
144 %>
145 <a href="<%=$rel$d%>"><%=d%></a>
146 <%
147 }
148 %>
149 <%-- main display --%>
150 <form action="<%=$rel$dir$file%>" method="POST">
151 <table>
152 <%
153 if {"" == $file} {
154 %>
155 <tr>
156 <th>
157 <%
158 foreach d $mvdirs { %><%=d%>&nbsp;<% }
159 %>
160 </th>
161 <th>
162 From</th>
163 <th>Date</th>
164 <th>Size</th>
165 <th>Subject</th>
166 </tr>
167 <%
168 foreach mv [request get 1] {
169 ::puts stderr $mv
170 if [regexp {^(\w\w\w)/(\S*)$} $mv - dest file] {
171 file rename $dir/$file $dest
172 %>
173 <tr>
174 <td>moved</td>
175 <td><%"file%></td>
176 <td>to</td>
177 <td><%"dest%></td>
178 </tr>
179 <%
180 }
181 }
182 cd $dir
183 foreach f [glob *] {
184 # file from date subject size content-type
185 set l [mscan $f]
186 %>
187 <tr>
188 <td>
189 <%
190 foreach d $mvdirs {
191 %>
192 <input type="checkbox" name="1" value="<%=d%>/<%?lindex $l 0%>"/>
193 <%
194 }
195 %>
196 </td>
197 <td><%"lindex $l 1%></td>
198 <td><%"lindex $l 2%></td>
199 <td><%"lindex $l 4%></td>
200 <td><a href="<%=dir%>/<%?lindex $l 0%>"><%"lindex $l 3%></a></td>
201 </tr>
202 <%
203 }
204 } else { # file view
205 set msg [initialize -file $dir$file]
206 foreach h [getheader $msg -names] {
207 foreach v [getheader $msg $h] {
208 %>
209 <tr>
210 <td><%"h%></td>
211 <td><%"v%></td>
212 </tr>
213 <%
214 }
215 }
216 set tpart ""
217 if {"text/plain" == [getproperty $msg content]} {
218 set tpart $msg
219 } elseif {![catch {set parts [getproperty $msg parts]}]} {
220 foreach p $parts {
221 set ct [getproperty $p content]
222 %>
223 <tr>
224 <td>part</td>
225 <td><%"ct%></td>
226 </tr>
227 <%
228 if {"text/plain" == $ct} {
229 set tpart $p
230 }
231 }
232 }
233 if {"" != $tpart} {
234 %>
235 <tr><td colspan="2"><pre>
236 <%"getbody $tpart%>
237 </pre></td></tr>
238 <%
239 }
240 }
241 %>
242 </table>
243 <input type="submit" name="2" value="ok"/>
244 <%-- send form --%>
245 <table>
246 <tr><td>to</td><td><input type="text" name="3" size="64"/></td></tr>
247 <tr><td>subject</td><td><input type="text" name="4" size="64"/></td></tr>
248 <tr><td colspan="2">
249 <textarea name="5" width="78" rows="20" cols="78"></textarea>
250 </td></tr>
251 </table>
252 </form>
253 </body>
254 </html>

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26