[REBOL] Re: saving file from detach.r
From: mario:cassani:icl at: 15-Jun-2001 10:53
> Hi, is there anybody out there who tell me how to save the
> file(s) detached from a mail with detach.r.
>
> Thanks for your comments in advance.
> Thorsten
I tried a couple of scripts to detach mime from mail
but one was too slow and the other was making a mess with
filenames with spaces so I changed the faster to extract the
right name.
Here comes the demime script along with the sample
script to use it.
<< File: demime.r >>
8<-----8<-----8<-----8<-----8<-----8<-----8<-----8<-----
REBOL [
Title: "Import attachments into a email object field."
Date: 13-June-2001
Author: "Mario Cassani"
Email: [dmxcas--tin--it]
File: %demime.r
Purpose: {
To extract the email attachments of an email object and
place them as a block in a field of the object.
}
History: [
13-June-2001 "Mario Cassani" {
Fixed bug where filenames with spaces were cut.
}
15-June-2000 "Brett Handley" {
Fixed bug where content-transfer-encoding was missing.
Now treats all content-types other than text and multipart as
files.
extract-mime-attachments skips content-type of text.
Changed script name from import-attachments to
manipulate-attachments.
Changed filename of %none to none where filename not specified.
}
]
Comment: {
Code borrowed heavily from %detach.r by Bohdan Lechnowsky.
I'd be glad to receive any ammendments you make to my script -
though I
reserve the right to include them in my script in any way I see fit.
Further adapted "Brett Handley" %import-attachments.r to handle the
attachments filenames.
}
Disclaimer: {
I provide this script freely for you to use so long as you agree not
to hold me liable for any problems that arise in the use of this
script.
}
Category: 'email
]
multi-replace: function [str tags][ptr][
foreach [tag symbol] tags [
str: head str
while [ptr: find str tag][
str: back insert (remove/part ptr (length? tag)) symbol
]
]
head str
]
extract-mime-parts: function [
"Extracts the separate parts of a multipart mime message."
msg [object!]
][
boundary delimiter close-delimiter
msg-part parse-result
return-block
][
; Get the boundary
Prin "Begin multipart using boundary "
boundary: msg/content-type
either string? boundary [
if boundary: find/tail boundary {boundary=} [
boundary: trim/with boundary {"}
]
][
if start: find msg/content "^/--" [
boundary: copy/part next start find next start newline
]
]
print [boundary]
; Get the parts
return-block: make block! 2
delimiter: rejoin ["--" boundary newline]
close-delimiter: rejoin ["--" boundary "--" newline]
parse-result: parse msg/content [
copy prologue to delimiter
some [ thru delimiter copy msg-part [to delimiter | to
close-delimiter]
(append return-block msg-part)]
thru close-delimiter copy epilogue to end
]
if not parse-result [Print "Error: Assumption failed while parsing
parts."]
Print ["End multipart using boundary " boundary]
Print [length? return-block "part(s) found"]
return-block
]
get-mime-content-type: function [ msg [object!]
][type][
; Determine the content-type.
load content-type: pick parse msg/content-type none 1
]
extract-mime-multipart-msg: function [
msg [object!]
/nest
][
msg-part msg-parts msg-in-part return-block nested-block
][
return-block: make block! 3
msg-parts: extract-mime-parts msg
either nest [
nested-block: make block! 2
foreach msg-part msg-parts [
msg-in-part: extract-mime-contents/nest (parse-header none
msg-part)
if msg-in-part [ append/only nested-block msg-in-part ]
]
append return-block reduce [get-mime-content-type msg none]
append/only return-block nested-block
][
foreach msg-part msg-parts [
msg-in-part: extract-mime-contents (parse-header none msg-part)
if msg-in-part [ append return-block msg-in-part ]
]
]
return-block
]
extract-mime-file: function [
msg-object [object!]
][atch content-spec filename a-file][
content-spec: parse msg-object/content-type {";}
; *** Here comes the changed code
filename: find/tail msg-object/content-type {name="}
if not none? filename [
head remove back tail filename
a-file: to-file filename
]
Print [" Part:" content-spec/1 newline " name:" filename newline]
atch: copy msg-object/content
while [find ["^/" " " "^-" "-"] back tail atch][remove back tail atch]
if (in msg-object 'content-transfer-encoding) [
if find msg-object/content-transfer-encoding "64" [
atch: do append insert head atch "64#{" "}"
]
if find msg-object/content-transfer-encoding "quoted-printable" [
atch: multi-replace atch ["=" "=" "=^/" "" "=20" " " "=0A"
^/
]
]
]
reduce [get-mime-content-type msg-object a-file atch]
]
extract-mime-contents: function [
"Return a block of content-type filename data triples."
msg [object!] "Email object"
/nest "Preserve nested multipart message using nested blocks."
][return-block][
switch/default pick get-mime-content-type msg 1 [
multipart [ return-block: either nest
[extract-mime-multipart-msg/nest msg][extract-mime-multipart-msg msg] ]
] [ return-block: extract-mime-file msg ]
return-block
]
----->8----->8----->8----->8----->8----->8----->8----->8
<< File: demime-demo.r >>
8<-----8<-----8<-----8<-----8<-----8<-----8<-----8<-----
REBOL [
Title: "Attachment extraction demo"
Date: 13-June-2001
Author: "Mario Cassani"
Email: [dmxcas--tin--it]
File: %demime-demo.r
Purpose: {
Show how to extract attachments using %demime.r
}
History: [
13-June-2001 "Mario Cassani" {
First release.
}
]
Disclaimer: {
I provide this script freely for you to use so long as you agree not
to hold me liable for any problems that arise in the use of this
script.
}
Category: 'email
]
do %demime.r
; ### Test code begins here
mmsg: import-email read %Demime-Demo.txt
; A serie of strings containing a mime part each one
print join newline "*** extract-mime-parts"
print "============================"
pippo: extract-mime-parts mmsg
; A path! of the main mime/type (multipart/mixed or type/category)
print join newline "*** get-mime-content-type"
print "============================"
probe pippo: get-mime-content-type mmsg
; A 3 by 3 serie of: mime/type(path), attachment/name(string),
attachment/body(string)
print join newline "*** extract-mime-multipart-msg"
print "============================"
pippo: extract-mime-multipart-msg mmsg
; A 3 serie of main mime/type (multipart/mixed or type/category):
mime/type(path), attachment/name(string), attachment/body(string)
print join newline "*** extract-mime-file"
print "============================"
pippo: extract-mime-file mmsg
; A serie of strings 3 by 3: mime/type, attachment/name, attachment/body
print join newline "*** extract-mime-contents"
print "============================"
pippo: extract-mime-contents mmsg
spippo: length? pippo
for i 1 spippo 3 [
j: i + 1
k: j + 1
if not none? pippo/:j [
write/binary pippo/:j pippo/:k
]
]
halt
----->8----->8----->8----->8----->8----->8----->8----->8
NB A %Demime-Demo.txt file with attachment is expected.
Sorry for the error with the attachments.
Mario
