saving file from detach.r

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 Here comes the demime script along with the sample script to use it. <<demime.r>> <<demime-demo.r>> NB A %Demime-Demo.txt file with attachment is expected. Best regards Mario ============================================================ Mario Cassani PGP Key fingerprint: 9929 74CF 62E9 A7A4 60D6 05DC 8034 F354 ------------------------------------------------------------ (to) optimize: Make a program faster by improving the algorithms rather than by buying a faster machine. ============================================================ -- Binary/unsupported file stripped by Listar -- -- Type: application/octet-stream -- File: demime.r -- Binary/unsupported file stripped by Listar -- -- Type: application/octet-stream -- File: demime-demo.r

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

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

It is simply one single email message as is read from a pop address and saved to a text file: 8<-----8<-----8<-----8<-----8<-----8<-----8<-----8<-----8<----- mailbox: open pop://user:[password--pop--server--net] msgfull: first mailbox write %Demime-Demo.txt msgfull close mailbox 8<-----8<-----8<-----8<-----8<-----8<-----8<-----8<-----8<----- No "easy" attachment: it's better you learn from the code. NB The above snipplet saves only the first message, if no attachment is into it nothing will be decoded... Have fun Mario

== [%New Text Document.txt "text/plain" "this is a test^/" %Copy of New Text Document.txt "text/pl ain" "this is a test^... Image attachments:

== [%test.jpg "image/jpeg" #{ FFD8FFE000104A46494600010001004800480000FFFE001F4C45414420546563 686E6F6C6F6769657320496E632E2056... In this last example if I wanted to save the image I would use write/binary r/1 r/3 If I wanted to view the image using rebol view I would use view layout [image load r/3] The load converts the binary to an image! datatype. This works for View but not Core 2.5 which is one reason I don't do it within mime-model.r. The other being that the write/binary would fail on the image! datatype. Regards, Brett.