OpenACS

maltes
committed
MAIN:maltes:20070405113722
on 05 Apr 07
Fixed mail-through
/tcl/contacts-callback-procs.tcl (+7 -3)
1268 1268     @creation-date 2005-12-18
1269 1269    
1270 1270     @param array        An array with all headers, files and bodies. To access the array you need to use upvar.
1271 1271     @return             nothing
1272 1272     @error
1273 1273 } {
1274 1274     # get a reference to the email array
1275 1275     upvar $array email
1276 1276
1277 1277     # Take a look if the email contains an email with a "#"
1278 1278     set pot_email [lindex [split $email(to) "@"] 0]
1279 1279     if {[string last "#" $pot_email] > -1} {
1280 1280         # A match was found, now just forward the email
1281 1281         regsub -all {#} $pot_email {@} to_addr
1282 1282         set from_addr [lindex $email(from) 0]
1283 1283         regsub -all {@} $from_addr {#} reply_to
1284 1284         set reply_to_addr "${reply_to}@[acs_mail_lite::address_domain]"
1285 1285
1286 1286         # make the bodies an array
1287 1287         template::util::list_of_lists_to_array $email(bodies) email_body
1288           
  1288         ns_log Notice "Mail through e-mail:: $email(bodies)"
1289 1289         if {[exists_and_not_null email_body(text/html)]} {
1290 1290             set body $email_body(text/html)
1291 1291             set mime_type "text/html"
1292 1292         } else {
  1293             if {[exists_and_not_null email_body(text/plain)]} {
1293 1294                 set body $email_body(text/plain)
  1295             } else {
  1296                 set body ""
  1297             }
1294 1298             set mime_type "text/plain"
1295 1299         }
1296 1300
1297 1301         # Deal with the files
1298 1302         set files ""
1299 1303         set file_ids ""
1300 1304         set import_p 1
1301 1305         # As this is a connection less callback, set the IP Address to local
1302 1306         set peeraddr "127.0.0.1"
1303 1307
1304 1308         foreach file $email(files) {
1305 1309             set file_title [lindex $file 2]
1306 1310             set mime_type [lindex $file 0]
1307 1311             set file_path [ns_tmpnam]
1308 1312             set f [open $file_path w+]
1309 1313             fconfigure $f -translation binary
1310 1314             puts -nonewline $f [lindex $file 3]
1311 1315             close $f
1312 1316            
1313 1317             # Shall we import the file into the content repository ?