Posted By

reboltutorial on 12/11/10


Tagged


Versions (?)

Secure Send


 / Published in: R
 

URL: http://rebol.wik.is/Protocols/Secure_Send

  1. REBOL [
  2. Title: "REBOL Protocols: Send Email"
  3. Version: 2.7.6
  4. Rights: "Copyright REBOL Technologies 2008. All rights reserved."
  5. Home: http://www.rebol.com
  6. Date: 14-Mar-2008
  7.  
  8. ; You are free to use, modify, and distribute this file as long as the
  9. ; above header, copyright, and this entire comment remains intact.
  10. ; This software is provided "as is" without warranties of any kind.
  11. ; In no event shall REBOL Technologies or source contributors be liable
  12. ; for any damages of any kind, even if advised of the possibility of such
  13. ; damage. See license for more information.
  14.  
  15. ; Please help us to improve this software by contributing changes and
  16. ; fixes. See http://www.rebol.com/support.html for details.
  17. ]
  18.  
  19. ssend: func [
  20. "Send a message to an address (or block of addresses)"
  21. ;Note - will also be used with REBOL protocol later.
  22. address [email! block!] "An address or block of addresses"
  23. message "Text of message. First line is subject."
  24. /only "Send only one message to multiple addresses"
  25. /header "Supply your own custom header"
  26. header-obj [object!] "The header to use"
  27. /attach "Attach file, files, or [.. [filename data]]"
  28. files [file! block!] "The files to attach to the message"
  29. /subject "Set the subject of the message"
  30. subj "The subject line"
  31. /show "Show all recipients in the TO field"
  32. /local smtp-port boundary make-boundary tmp from
  33. ][
  34. make-boundary: does []
  35.  
  36. if file? files [files: reduce [files]] ; make it a block
  37. if email? address [address: reduce [address]] ; make it a block
  38. message: either string? message [copy message] [mold message]
  39.  
  40. if not header [ ; Clone system default header
  41. header-obj: make system/standard/email [
  42. subject: any [subj copy/part message any [find message newline 50]]
  43. ]
  44. ]
  45. if subject [header-obj/subject: subj]
  46. either none? header-obj/from [
  47. if none? header-obj/from: from: system/user/email [net-error "Email header not set: no from address"]
  48. if all [string? system/user/name not empty? system/user/name][
  49. header-obj/from: rejoin [system/user/name " <" from ">"]
  50. ]
  51. ][
  52. from: header-obj/from
  53. ]
  54. if none? header-obj/to [
  55. header-obj/to: tmp: make string! 20
  56. if show [
  57. foreach email address [repend tmp [email ", "]]
  58. clear back back tail tmp
  59. ]
  60. ]
  61. if none? header-obj/date [header-obj/date: to-idate now]
  62.  
  63. if attach [
  64. boundary: rejoin ["--__REBOL--" system/product "--" system/version "--" checksum form now/precise "__"]
  65. header-obj/MIME-Version: "1.0"
  66. header-obj/content-type: join "multipart/mixed; boundary=" [{"} skip boundary 2 {"}]
  67. message: build-attach-body message files boundary
  68. ]
  69.  
  70. ;-- Send as an SMTP batch or individually addressed:
  71. smtp-port: open [scheme: 'ssmtp]
  72. either only [ ; Only one message to multiple addrs
  73. address: copy address
  74. ; remove non-email values
  75. remove-each value address [not email? :value]
  76. message: head insert insert tail net-utils/export header-obj newline message
  77. insert smtp-port reduce [ email address message ]
  78. ] [
  79. foreach addr address [
  80. if email? addr [
  81. if not show [insert clear header-obj/to addr]
  82. tmp: head insert insert tail net-utils/export header-obj newline message
  83. ; probe tmp
  84. insert smtp-port reduce [from reduce [addr] tmp]
  85. ]
  86. ]
  87. ]
  88. close smtp-port
  89. ]
  90.  
  91. resend: func [
  92. "Relay a message"
  93. to from message /local smtp-port
  94. ][
  95. smtp-port: open [scheme: 'ssmtp]
  96. insert smtp-port reduce [from reduce [to] message]
  97. close smtp-port
  98. ]
  99.  
  100. build-attach-body: function [
  101. {Return an email body with attached files.}
  102. body [string!] {The message body}
  103. files [block!] {List of files to send [%file1.r [%file2.r "data"]]}
  104. boundary [string!] {The boundary divider}
  105. ][
  106. make-mime-header
  107. break-lines
  108. file
  109. val
  110. ][
  111. make-mime-header: func [file] [
  112. net-utils/export context [
  113. Content-Type: join {application/octet-stream; name="} [file {"}]
  114. Content-Transfer-Encoding: "base64"
  115. Content-Disposition: join {attachment; filename="} [file {"^/}]
  116. ]
  117. ]
  118. break-lines: func [mesg data /at num] [
  119. num: any [num 72]
  120. while [not tail? data] [
  121. append mesg join copy/part data num #"^/"
  122. data: skip data num
  123. ]
  124. mesg
  125. ]
  126. if not empty? files [
  127. insert body reduce [boundary "^/Content-type: text/plain^/^/"]
  128. append body "^/^/"
  129. if not parse files [
  130. some [
  131. (file: none)
  132. [
  133. set file file! (val: read/binary file)
  134. | into [
  135. set file file!
  136. set val skip ;anything allowed
  137. to end
  138. ]
  139. ] (
  140. if file [
  141. repend body [
  142. boundary "^/"
  143. make-mime-header any [find/last/tail file #"/" file]
  144. ]
  145. val: either any-string? val [val] [mold :val]
  146. break-lines body enbase val
  147. ]
  148. )
  149. ]
  150. ] [net-error "Cannot parse file list."]
  151. append body join boundary "--^/"
  152. ]
  153. body
  154. ]

Report this snippet  

You need to login to post a comment.