Posted By

reboltutorial on 12/11/10


Tagged


Versions (?)

esmtp


 / Published in: R
 

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

  1. REBOL [
  2. Title: "REBOL Protocols: ESMTP"
  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. make Root-Protocol [
  20. {Communicate with ESMTP. This protocol is unusual in that it is
  21. a write only port. It is pass-thru and it sends an email at each
  22. INSERT; you need to insert a block with the from address, the to
  23. addresses, and the mail (complete with headers).
  24. There is no URL represenation of this entire protocol at this time
  25. (but there could be).}
  26.  
  27. port-flags: system/standard/port-flags/pass-thru
  28.  
  29. open-check: [ none "220"] ; ["HELO" system/network/host] "250"]
  30. close-check: ["QUIT" "221"]
  31. write-check: [ none "250"]
  32. data-check: ["DATA" "354"]
  33.  
  34. open: func [
  35. "Open the socket connection and confirm server response."
  36. port "Initalized port spec"
  37.  
  38. /local tmp auth-key ehlo-response auth-methods
  39. ] [
  40. ; open-proto port
  41. open-proto/secure/sub-protocol port 'ssl ;; ssl changes
  42. ; make the protocol RFC compliant - use EHLO if possible
  43. ehlo-response: attempt [net-utils/confirm/multiline/all port/sub-port [["EHLO" system/network/host] "250"]]
  44. either found? ehlo-response [
  45. auth-methods: make block! 3
  46. foreach response ehlo-response [
  47. parse response [
  48. ["250-" | "250"]
  49. "AUTH" any [
  50. "CRAM-MD5" (append auth-methods 'cram)
  51. |
  52. "PLAIN" (append auth-methods 'plain)
  53. |
  54. "LOGIN" (append auth-methods 'login)
  55. |
  56. to " "
  57. ]
  58. ]
  59. ]
  60. net-utils/net-log ["Supported auth methods:" auth-methods]
  61. ; fix: only ask once if the user used set-net ask
  62. port/user: system/schemes/esmtp/user ; port/user
  63. port/pass: system/schemes/esmtp/pass ; port/pass
  64. ; do authn if needed
  65.  
  66. if all [found? port/user found? port/pass] [
  67. case [
  68. find auth-methods 'cram [
  69. tmp: net-utils/confirm port/sub-port ["AUTH CRAM-MD5" "334"]
  70. parse/all tmp ["334 " copy auth-key to end]
  71. auth-key: debase auth-key
  72. ; compute challenge response
  73. auth-key: checksum/method/key auth-key 'md5 port/pass
  74. ; try to authenticate
  75. net-utils/confirm port/sub-port reduce [
  76. enbase reform [port/user lowercase enbase/base auth-key 16]
  77. "235"
  78. ]
  79. ]
  80. find auth-methods 'login [
  81. net-utils/net-log ["WARNING! Using AUTH LOGIN."]
  82. net-utils/confirm port/sub-port reduce [
  83. "AUTH LOGIN" "334"
  84. enbase port/user "334"
  85. enbase port/pass "235"
  86. ]
  87. ]
  88. find auth-methods 'plain [
  89. net-utils/net-log ["WARNING! Using AUTH PLAIN."]
  90. net-utils/confirm port/sub-port reduce [
  91. join "AUTH PLAIN " enbase rejoin [port/user #"^@" port/user #"^@" port/pass]
  92. "235"
  93. ]
  94. ]
  95. true [
  96. net-utils/net-log ["None of the server's authentication methods are supported. Can't authenticate."]
  97. ]
  98. ]
  99. ]
  100. ] [
  101. ; only plain SMTP supported - no auth possible
  102. net-utils/confirm port/sub-port [["HELO" system/network/host] "250"]
  103. ]
  104. ]
  105.  
  106. confirm-command: func [
  107. port
  108. command
  109. ] [
  110. net-utils/confirm port/sub-port reduce [rejoin command "250"]
  111. ]
  112.  
  113. insert: func [
  114. "INSERT called on port"
  115. port "Opened port"
  116. data
  117. ] [
  118. if string? data/1 [
  119. use [ e ][
  120. either parse/all data/1 [ thru "<" copy e to ">" to end ][
  121. if error? try [ data/1: to-email e ][
  122. net-error "ESMTP: invalid from address"
  123. ]
  124. ][ net-error "ESMTP: invalid from address" ]
  125. ]
  126. ]
  127. if not all [
  128. block? :data
  129. parse data [email! into [some email!] string!]
  130. ][net-error "ESMTP: Invalid command"]
  131. confirm-command port ["MAIL FROM: <" data/1 ">"]
  132. foreach addr data/2 [
  133. confirm-command port ["RCPT TO: <" addr ">"]
  134. ]
  135. net-utils/confirm port/sub-port data-check
  136. system/words/insert port/sub-port replace/all copy data/3 "^/." "^/.."
  137. system/words/insert port/sub-port "."
  138. net-utils/confirm port/sub-port write-check
  139. ]
  140.  
  141. net-utils/net-install SSMTP self 465
  142. ]

Report this snippet  

Comments

RSS Icon Subscribe to comments
Posted By: reboltutorial on December 11, 2010

How to send email securely

do %prot-ssmtp.r do %prot-ssend.r

set-net [ [email protected] smtp.gmail.com none none none none [email protected] "mypass" ]

ssend [email protected] "Hello ... test message"

You need to login to post a comment.