├── LICENSE └── APLSource ├── SendMail.dyalog └── SMTP.dyalog /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2021 Dyalog 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /APLSource/SendMail.dyalog: -------------------------------------------------------------------------------- 1 | (rc msg client log)←clientArgs SendMail messageArgs;⎕ML;⎕IO;params;msgParams;log 2 | ⍝ Simple cover to send SMTP mail 3 | ⍝ Requires: SMTP class 4 | 5 | ⍝ Version 1.1 2021-09-09 6 | 7 | ⍝ rc - return code; 0=no error, 1=error from the SMTP server, anything else=other error 8 | ⍝ msg - descriptive message 9 | ⍝ client - reference to instance of SMTP (only returned when clientArgs is the server definition) 10 | ⍝ log - log of server responses 11 | 12 | 13 | ⍝ clientArgs is one of: 14 | ⍝ A client definition in one of the following formats: 15 | ⍝ ∘ a vector of Server Port From [Password [Userid [Secure]]] 16 | ⍝ ∘ a namespace containing required named elements: Server Port From 17 | ⍝ and optionally Password Userid Secure plus any other parameters applicable to the SMTP class 18 | ⍝ where 19 | ⍝ Server - address of the SMTP server 20 | ⍝ Port - port for the SMTP server 21 | ⍝ From - "from" email address; if Userid is not specified From is also used for authentication if necessary 22 | ⍝ Password - password to access the SMTP server 23 | ⍝ Userid - userid for authentication; not needed if it's the same as From 24 | ⍝ Secure - Boolean indicating whether to use SSL/TLS; if not specified Secure will be inferred from the Port 25 | ⍝ Or 26 | ⍝ ∘ an instance of the SMTP class created by SendMail 27 | 28 | ⍝ messageArgs is one of: 29 | ⍝ ∘ a vector of To Subj Body 30 | ⍝ ∘ a namespace containing required named elements: To Subj Body 31 | ⍝ and optionally any other parameters applicable to the SMTP.Message class 32 | 33 | ⍝ Once the SMTP client instance has been created, it can be passed as the left argument 34 | ⍝ in subsequent calls to Sendmail 35 | 36 | ⍝ Examples: 37 | ⍝ (clt←⎕NS'').(Server Port From Password)←'mail.abc.com' 465 'me@abc.com' 'secret' 38 | ⍝ Client←3⊃clt SendMail '' ⍝ create the client instance 39 | ⍝ (msg←⎕NS'').(To Subj Body)←'you@xyz.com' 'Hello' 'Hi there!' 40 | ⍝ Client SendMail msg ⍝ client instance is the left argument here 41 | ⍝ 42 | ⍝ The client instance can be created and message sent in a single call: 43 | ⍝ Client←3⊃clt SendMail msg 44 | 45 | ⎕IO←⎕ML←1 46 | 47 | (rc msg client log)←¯1 'Nothing done' '' '' 48 | params←0 49 | :Select ⎕NC⊂'clientArgs' 50 | :Case 2.1 ⋄ params←⎕NS'' ⋄ params.(Server Port From Password Userid Secure)←''⍬'' '' '' ¯1{(≢⍺)↑⍵,⍺↓⍨≢⍵},⊆clientArgs 51 | :Case 9.1 ⋄ params←clientArgs 52 | :Case 9.2 ⋄ client←clientArgs 53 | :Case 0 ⍝ not defined? do nothing 54 | :Else ⋄ →Exit⊣(rc msg)←¯1 'Invalid clientArgs' ⍝ paranoia 55 | :EndSelect 56 | 57 | :If params≢0 58 | :Trap 0 ⋄ client←⎕NEW SMTP params 59 | :Else ⋄ →Exit⊣(rc msg)←⎕DMX.(EN(EM,' while creating client')) 60 | :EndTrap 61 | (rc msg)←0 'SMTPClient created' 62 | :EndIf 63 | 64 | :If ~0∊⍴messageArgs 65 | :If 0∊⍴client ⋄ →Exit⊣(rc msg)←¯1 'No SMTPClient defined' ⋄ :EndIf 66 | :Select ⎕NC⊂'messageArgs' 67 | :Case 2.1 ⋄ msgParams←⎕NS'' ⋄ msgParams.(To Subj Body)←'' '' ''{(≢⍺)↑⍵,⍺↓⍨≢⍵},⊆messageArgs 68 | :Case 9.1 ⋄ msgParams←messageArgs 69 | :Else ⋄ →Exit⊣(rc msg)←¯1 'Invalid messageArgs' ⍝ paranoia 70 | :EndSelect 71 | (rc msg log)←client.Send msgParams 72 | :EndIf 73 | Exit: 74 | -------------------------------------------------------------------------------- /APLSource/SMTP.dyalog: -------------------------------------------------------------------------------- 1 | :Class SMTP 2 | 3 | ⍝ Based on original work by Conrad Hoesle-Kienzlen in 1999 4 | ⍝ Updated by Morten Kromberg to use UTF-8 text, 2009 5 | ⍝ Updated by Brian Becker in jan2011 to make compatible with Unix and Unicode 6 | ⍝ Updated by Brian Becker in mar2019 to use Conga, make it a class, etc 7 | 8 | (⎕IO ⎕ML)←1 9 | 10 | :field public Server←'' ⍝ server address 11 | :field public Port←⍬ ⍝ server port (default depends on whether running 587 or 465 (secure)) 12 | :field public From←'' ⍝ default from address for new messages 13 | :field public Userid←'' ⍝ userid for authentication (defaults to From) 14 | :field public Domain←'' ⍝ fully qualified domain name for EHLO command 15 | :field public Org←'' ⍝ optional organization 16 | :field public ReplyTo←'' ⍝ optional reply to email address 17 | :field public Password←'' ⍝ optional password (if server requires authentication) 18 | :field public XMailer←'Dyalog SMTP Client 1.1.0' ⍝ client identifier 19 | :field public Secure←¯1 ⍝ indicates whether to use SSL/TLS, 0 = no, 1 = yes, ¯1 = let port number determine 20 | :field public TLSFlags←32 ⍝ by default, accept server certificate without validating (see Conga User Guide Appendix C) 21 | :field public CongaRootName←'SMTP' 22 | 23 | :field public shared CongaRef←'' ⍝ user-supplied reference to location of Conga namespace 24 | :field public shared LDRC←'' ⍝ reference to Conga library instance after CongaRef has been resolved 25 | 26 | :field _clt←'' ⍝ Conga client id 27 | :field _loggedOn←0 28 | :field _EHLOResponse←'' 29 | :field _conx←'' ⍝ Conga connection id 30 | 31 | ∇ r←Version 32 | :Access public shared 33 | r←'SMTP' '1.4' '2021-09-09' 34 | ∇ 35 | 36 | :property EHLOResponse 37 | :access public 38 | ∇ r←get 39 | r←_EHLOResponse 40 | ∇ 41 | :endproperty 42 | 43 | :property Clt ⍝ client 44 | :access public 45 | ∇ r←get 46 | r←_clt 47 | ∇ 48 | :endproperty 49 | 50 | :property Conx ⍝ client connection 51 | :access public 52 | ∇ r←get 53 | r←_conx 54 | ∇ 55 | :endproperty 56 | 57 | :property LoggedOn ⍝ has authentication taken place? 58 | :access public 59 | ∇ r←get 60 | r←_loggedOn 61 | ∇ 62 | :endproperty 63 | 64 | :section Utilities 65 | if←⍴⍨ 66 | unless←↓⍨ 67 | okay←{0=⊃⍺.(rc msg log)←{3↑⍵,(≢⍵)↓¯99 '' ''},⊆⍵} 68 | empty←0∘∊⍴ 69 | lc←{2::0(819⌶)⍵ ⋄ ¯3 ⎕C ⍵} 70 | splitOn←{⍵{(≢⍺)↓¨⍵⊂⍨⍺⍷⍵}⍵,⍺} ⍝ e.g. response splitOn CRLF 71 | 72 | ∇ r←Config 73 | ⍝ returns current service configuration 74 | :Access public 75 | r←↑{⍵≡'Password':⍵'********' ⋄ ⍵(⍎⍵)}¨⎕THIS⍎'⎕NL ¯2.2 ¯2.3' 76 | ∇ 77 | 78 | ∇ r←CRLF 79 | r←⎕UCS 13 10 80 | ∇ 81 | 82 | 83 | ∇ (rc msg)←Connected;r;state 84 | :Access public 85 | msg←'SMTP server has not been connected' 86 | →0↓⍨rc←Clt≢'' 87 | :Trap 0 ⍝ handle any Conga error, LDRC not defined, etc 88 | r←LDRC.Describe Clt 89 | :Else 90 | →0⊣(rc msg)←0 'Conga could not query client' 91 | :EndTrap 92 | :If 0=⊃r ⍝ good Conga return code? 93 | :Select state←lc 2⊃3↑2⊃r 94 | :Case 'client' 95 | (rc msg)←1 'connected' 96 | :Case 'error' 97 | (rc msg)←0 'not connected (possible server timeout)' 98 | :Else 99 | (rc msg)←0 'unknown client state: ',∊⍕state 100 | :EndSelect 101 | :Else 102 | (rc msg)←0 'non-zero Conga return code' 103 | :EndIf 104 | ∇ 105 | 106 | :endsection 107 | 108 | ∇ make 109 | :Access public 110 | :Implements constructor 111 | ∇ 112 | 113 | ∇ make1 args 114 | :Access public 115 | :Implements constructor 116 | 117 | ⍝ args is either a vector with up to 6 elements: [1] server, [2] port, [3] userid, [4] password, [5] from, [6] replyto 118 | ⍝ or a namespace containing named elements 119 | :Select ⎕NC⊂'args' 120 | :Case 2.1 ⍝ variable 121 | (Server Port From Password Userid ReplyTo Secure)←(Server Port From Password Userid ReplyTo Secure){(≢⍺)↑⍵,(≢⍵)↓⍺},⊆args 122 | :Case 9.1 ⍝ namespace 123 | (Server Port From Password Userid ReplyTo Secure)←args{6::⍎⍵ ⋄ ⍺⍎⍵}¨'Server' 'Port' 'From' 'Password' 'Userid' 'ReplyTo' 'Secure' 124 | :Else 125 | ⎕←'*** invalid constructor argument' 126 | :EndSelect 127 | ∇ 128 | 129 | ∇ unmake;base 130 | :Implements destructor 131 | :Trap 0 132 | {}Logoff 133 | :If 0∊≢⎕INSTANCES base←⊃⊃⎕CLASS ⎕THIS 134 | base.LDRC←'' 135 | :EndIf 136 | :EndTrap 137 | ∇ 138 | 139 | ∇ r←NewClient args 140 | :Access public shared 141 | r←##.⎕NEW ⎕THIS args 142 | ∇ 143 | 144 | ∇ r←NewMessage args 145 | :Access public 146 | ⍝ Create a mew message instance 147 | r←⎕NEW Message args 148 | r.Client←⎕THIS 149 | r.(From XMailer ReplyTo Org)←r.(From XMailer ReplyTo Org){0∊⍴⍺:⍵ ⋄ ⍺}¨From XMailer ReplyTo Org 150 | ∇ 151 | 152 | ∇ (rc msg log)←Send mail;logIt;message;text;rec 153 | :Access public 154 | ⍝ mail is one of: 155 | ⍝ ∘ an instance of Message 156 | ⍝ ∘ a namespace with named elements 157 | ⍝ ∘ a vector of [1] to, [2] subj, [3] body 158 | 159 | log←'' 160 | logIt←{⍵⊣log,←⍵[2]} 161 | (rc msg log)←¯1 '' '' 162 | 163 | ⍝ If one of Userid or From is specified, use it for both 164 | :If 0∊⍴Userid ⋄ Userid←From ⋄ :EndIf 165 | :If 0∊⍴From ⋄ From←Userid ⋄ :EndIf 166 | 167 | →Exit if 0<≢msg←(0∊⍴From)/'No From address specified' 168 | :If 0=mail.⎕NC'From' 169 | :OrIf 0∊⍴mail.From 170 | mail.From←From 171 | :EndIf 172 | 173 | :Select ⎕NC⊂'mail' 174 | :Case 9.2 ⍝ instance 175 | message←mail 176 | :CaseList 9.1 2.1 ⍝ namespace or vector 177 | message←NewMessage mail 178 | :Else 179 | →Exit⊣msg←'Invalid argument' 180 | :EndSelect 181 | 182 | →Exit if 0≠⊃logIt(rc msg text)←message.Compose 183 | 184 | :If ~⊃Connected 185 | →Exit if 0≠⊃logIt(rc msg)←Connect ⍝ connect to SMTP server 186 | :EndIf 187 | 188 | :If ~LoggedOn 189 | →Exit if 0≠⊃logIt(rc msg)←Logon 190 | :EndIf 191 | 192 | →Exit if 0≠⊃logIt(rc msg)←Ping ⍝ ping the server to make sure it's still up 193 | 194 | →Err if 0≠⊃logIt(rc msg)←Do'MAIL FROM: ',message.(normalizeAddr extractAddr From) 195 | :For rec :In message.(normalizeAddr∘extractAddr¨Recipients) 196 | {}logIt Do'RCPT TO: ',rec 197 | :EndFor 198 | →Err if 0≠⊃logIt(rc msg)←Do'DATA' 199 | →Err if 0≠⊃logIt(rc msg)←Do text,CRLF,'.' 200 | →Exit 201 | Err: 202 | logIt Do'RSET' 203 | Exit: 204 | ∇ 205 | 206 | ∇ (rc msg)←{crlf}Xmit data;tmp 207 | :Access public 208 | ⍝ transmit data without waiting for a response 209 | ⍝ {crlf} is a Boolean (default=0) indicating whether to append CRLF to data 210 | ⍝ After receiving a "DATA" comment, the SMTP server does not send a response until it receives CRLF,'.',CRLF 211 | ⍝ so, the typical use of Xmit would be to send the headers and content of the message and ending with a Do CRLF,'.' 212 | :If 0=⎕NC'crlf' ⋄ crlf←0 ⋄ :EndIf 213 | msg←'Sent' 214 | →Exit if 0=rc←⊃tmp←LDRC.Send Clt data,crlf/CRLF 215 | msg←1↓∊' ',¨⍕¨(tmp,'' '')[2 3] 216 | Exit: 217 | ∇ 218 | 219 | ∇ (rc msg)←Connect;r;uid;dom;cert 220 | :Access public 221 | (rc msg)←¯1 '' 222 | :If 0∊⍴Server ⋄ →Exit⊣msg←'Server not defined' ⋄ :EndIf 223 | 224 | :If 0∊⍴Port ⍝ if port not specified, select default based on Secure 225 | Port←(1+0⌈Secure)⊃587 465 226 | :ElseIf ¯1=Secure ⍝ else if Secure is not set, set based on Port 227 | Secure←Port∊465 228 | :EndIf 229 | 230 | Secure←0⌈Secure 231 | Port←⊃Port 232 | 233 | :If ~Port∊⍳65535 ⋄ →Exit⊣msg←'Invalid Port' ⋄ :EndIf 234 | 235 | :If 0∊⍴uid←Userid ⋄ uid←From ⋄ :EndIf 236 | :If 0∊⍴dom←Domain 237 | dom←Message.extractAddr uid 238 | dom←(⌽∧\'@'≠⌽dom)/dom 239 | :EndIf 240 | 241 | :If 0∊⍴dom ⋄ →Exit⊣msg←'Domain not defined' ⋄ :EndIf 242 | 243 | :If 0∊⍴LDRC 244 | :OrIf {0::1 ⋄ 0≠⊃LDRC.Describe'.'}'' 245 | (rc msg)←Init CongaRootName 246 | :EndIf 247 | 248 | cert←⍬ 249 | :If Secure 250 | :If 0∊⍴LDRC.X509Cert.LDRC ⋄ LDRC.X509Cert.LDRC←LDRC ⋄ :EndIf 251 | cert←('X509'(⎕NEW LDRC.X509Cert))('SSLValidation'TLSFlags) 252 | :EndIf 253 | 254 | 255 | :Select ⊃r←LDRC.Clt(''Server Port'text' 2000000,cert) 256 | :Case 0 257 | _clt←2⊃r ⍝ Conga client name 258 | :If 0=⊃(rc msg)←Do'' ⍝ retrieve the server response 259 | (rc msg)←EHLO dom ⍝ log on user domain 260 | _EHLOResponse←msg 261 | :Else 262 | {}LDRC.Close _clt 263 | _clt←'' 264 | :EndIf 265 | :Case 100 ⍝ timeout 266 | msg←'Conga timeout on connect' 267 | :Else ⍝ some Conga error occured 268 | _clt←'' 269 | msg←'Conga error: ',,⍕LDRC.Error⊃r 270 | :EndSelect 271 | Exit: 272 | ∇ 273 | 274 | ∇ (rc msg)←EHLO domain;resp;m 275 | :Access public 276 | ⍝ Some SMTP servers (gmail in particular) break up the response to EHLO into multiple messages 277 | :If 0=⊃(rc msg)←Do'EHLO ',domain 278 | resp←msg splitOn CRLF 279 | :If '250 '≢4↑⊃⊢/resp ⍝ this makes the assumption that the EHLO response is in 2 parts only 280 | :If 0=⊃(rc m)←Do'' 281 | msg,←m 282 | :Else 283 | msg←m 284 | :EndIf 285 | :EndIf 286 | :EndIf 287 | ∇ 288 | 289 | ∇ (rc msg)←Logon;uid;email;rc;dom;elho;auth 290 | :Access public 291 | ⍝ Log on to an SMTP mail server optionally using AUTH LOGIN or AUTH PLAIN authentication if userid and password are non-empty 292 | ⍝ Other authentication types may be added in the future 293 | ⍝ If no password is set, then authentication is not done 294 | ⍝ 295 | (rc msg)←0 'No logon performed, Password is not defined' 296 | →Exit if 0∊⍴Password 297 | (rc msg)←¯1 '' 298 | :If ~⊃Connected 299 | →Exit if 0≠⊃(rc msg)←Connect 300 | :EndIf 301 | elho←' '(,⍨)¨(~EHLOResponse∊CRLF)⊆EHLOResponse 302 | :If 1≠≢auth←('^250.AUTH '⎕S'%')elho 303 | →Exit⊣msg←'250-AUTH server response was not found or was not proper' 304 | :EndIf 305 | uid←(1+0∊⍴Userid)⊃Userid From 306 | →Exit if~0∊⍴msg←(0∊⍴uid)/'No Userid or From address specified' 307 | auth←' '(≠⊆⊢)8↓⊃auth 308 | →('LOGIN' 'PLAIN'∊auth)/LOGIN,PLAIN 309 | →Exit⊣msg←'Only AUTH LOGIN or AUTH PLAIN are currently supported' 310 | LOGIN: 311 | →Exit if 0≠⊃(rc msg)←Do'AUTH LOGIN' 312 | →Exit if 0≠⊃(rc msg)←Do Message.base64enc uid 313 | →Exit⊣rc msg←Do Message.base64enc Password 314 | PLAIN: 315 | →Exit if 0≠⊃(rc msg)←Do'AUTH PLAIN' 316 | →Exit⊣rc msg←Do Message.base64enc uid,(⎕UCS 0),uid,(⎕UCS 0),Password 317 | Exit: 318 | _loggedOn←0=rc 319 | ∇ 320 | 321 | ∇ (rc msg)←Logoff 322 | :Access public 323 | ⍝ Log out from an SMTP mail server 324 | :If 0=⊃(rc msg)←Do'QUIT' 325 | rc←⊃LDRC.Close Clt 326 | :EndIf 327 | _loggedOn←0 328 | ∇ 329 | 330 | ∇ (rc msg)←Ping 331 | :Access public 332 | (rc msg)←Do'NOOP' 333 | ∇ 334 | 335 | ∇ (rc msg)←Reset 336 | :Access public 337 | (rc msg)←Do'RSET' 338 | ∇ 339 | 340 | ∇ r←Do cmd;cnt;rc;c 341 | :Access public 342 | →go 343 | ⍝ Send a command to an smtp server and retrieve answer 344 | ⍝ cmd: smtp command, or mail body, or empty vector 345 | ⍝ If cmd is an empty vector, the function returns a pending answer 346 | ⍝ from the server 347 | ⍝ r [1]=0 if OK (response was a 2XX) or 1 if error 348 | ⍝ [2]=status message starting with a 3-digit status number 349 | ⍝ 350 | ⍝ Valid commands are: 351 | ⍝ Name Parameter Description & return codes (S=success, E=error) 352 | ⍝ ---- ------------- ------------------------------------------------ 353 | ⍝ HELO Make yourself known to the server 354 | ⍝ S: 250; E: 421 500 501 504 355 | ⍝ EHLO Like HELO but request extended smtp services 356 | ⍝ S: 250; E: 421 500 501 504 357 | ⍝ NOTE: apart from code 250, the server answers with 358 | ⍝ a cr/lf delimited list of supported commands 359 | ⍝ MAIL FROM: Start a new mail, is your mail address 360 | ⍝ S: 250; E: 421 451 452 500 501 552 361 | ⍝ RCPT TO: Identify the recipients, up to 100 are allowed 362 | ⍝ S: 250 251; E: 421 450 451 452 500 501 503 550-553 363 | ⍝ DATA Initialize sending mail body 364 | ⍝ S: 354; E: 451 452 552 554 365 | ⍝ Send the mail body (use smtp_stuff to prepare it) 366 | ⍝ NOTE: there is no response until "end-of-mail" is sent. 367 | ⍝ . "end-of-mail" command, a line with only a dot and cr/lf 368 | ⍝ S: 250; E: 421 451 500 501 503 554 369 | ⍝ RSET Cancel the mail just sent 370 | ⍝ S: 250; E: 421 500 501 504 371 | ⍝ VRFY Verify a recipients mail address (often disabled) 372 | ⍝ S: 250 251; E: 421 500 501 502 504 550 551 553 373 | ⍝ EXPN Expand a mailing list (often disabled) 374 | ⍝ S: 250; E: 421 500 501 502 504 550 375 | ⍝ HELP [] Return a help message, optionally followed by a command 376 | ⍝ S: 211 214; E: 421 500 501 502 504 377 | ⍝ NOOP Returns success or error 378 | ⍝ S: 250; E: 421 500 379 | ⍝ QUIT End the smtp session 380 | ⍝ S: 221; E: 500 381 | ⍝ TURN Reverse the roles of client and server (DON't USE!) 382 | ⍝ S: 250; E: 500 502 503 383 | ⍝ 384 | ⍝ Meaning of the return codes: 385 | ⍝ NOTE: If the 3-digit number is followed by "-", there is more data to follow 386 | ⍝ 211 System status, or system help reply 387 | ⍝ 214 Help message 388 | ⍝ 220 Service ready 389 | ⍝ 221 Service closing transmission channel 390 | ⍝ 250 Requested mail action okay, completed 391 | ⍝ 251 User not local; will forward to (this is not an error!) 392 | ⍝ 354 Start mail input; end with . 393 | ⍝ 421 Service not available, closing transmission channel 394 | ⍝ 450 Requested mail action not taken: mailbox unavailable [E.g., mailbox busy] 395 | ⍝ 451 Requested action aborted: local error in processing 396 | ⍝ 452 Requested action not taken: insufficient system storage 397 | ⍝ 500 Syntax error, command unrecognized 398 | ⍝ 501 Syntax error in parameters or arguments 399 | ⍝ 502 Command not implemented 400 | ⍝ 503 Bad sequence of commands 401 | ⍝ 504 Command parameter not implemented 402 | ⍝ 550 Requested action not taken: mailbox unavailable 403 | ⍝ 551 User not local; please try 404 | ⍝ 552 Requested mail action aborted: exceeded storage allocation 405 | ⍝ 553 Requested action not taken: mailbox name not allowed (typo?) 406 | ⍝ 555 Only used by this program to indicate a special error condition 407 | go: 408 | :If ⊃c←Connected ⍝ if we're connected 409 | :If ~empty cmd 410 | :If 0≠⊃rc←LDRC.Send Clt(cmd,CRLF) 411 | →Exit⊣r←'555 Conga error: ',,⍕2↑rc 412 | :EndIf 413 | :EndIf 414 | cnt←0 415 | Try: 416 | :Select ⊃rc←LDRC.Wait Clt 2000 ⍝ wait up to 2 seconds 417 | :Case 0 418 | r←¯2↓4⊃rc ⍝ grab the data 419 | :Case 100 ⍝ timeout, try up to 3 times 420 | cnt+←1 421 | →Try if 3>cnt 422 | r←'555 Conga timeout' 423 | :Else 424 | r←'555 Conga error: ',,⍕2↑rc 425 | :EndSelect 426 | :Else ⍝ if the socket does not exist 427 | r←'555 SMTP server not connected - ',2⊃c 428 | :EndIf 429 | Exit: 430 | r←((⊃r)∊'45')r ⍝ check for error and return 431 | ∇ 432 | 433 | :Class Message 434 | :Field public From←'' 435 | :Field public Subj←'' 436 | :Field public ReplyTo←'' 437 | :Field public Org←'' 438 | :Field public To←'' ⍝ vector of email addresses 439 | :Field public CC←'' ⍝ vector of email addresses 440 | :Field public BCC←'' ⍝ vector of email addresses 441 | :Field public Headers←'' ⍝ vector of ('name' 'value') 442 | :Field public XMailer←'' 443 | :Field public Body←'' ⍝ character vector 'content' or vector of ('MIMEType' 'content') 444 | :Field public Attachments←'' ⍝ vector of ('filename' 'MIMEType' {'content'|''}) 445 | :Field public Client ⍝ reference to SMTP client that created this 446 | 447 | :Field _text←'' 448 | :field _recipients←'' 449 | 450 | :property Text 451 | :access public 452 | ∇ r←Get 453 | r←_text 454 | ∇ 455 | :endproperty 456 | 457 | :property Recipients 458 | :access public 459 | ∇ r←Get 460 | r←_recipients 461 | ∇ 462 | :endproperty 463 | 464 | default←{0∊⍴⍺ : ⍵ ⋄ ⍺} 465 | 466 | ∇ make 467 | :Access public 468 | :Implements constructor 469 | ∇ 470 | 471 | ∇ make1 args 472 | :Access public 473 | :Implements constructor 474 | :Select ⎕NC⊂'args' ⍝ namespace? 475 | :Case 9.1 476 | args{ 477 | 0≠⍺.⎕NC ⍵:⍎⍵,'←⍺⍎⍵' 478 | }¨'From' 'Subj' 'ReplyTo' 'Org' 'To' 'CC' 'BCC' 'MIMEType' 'Headers' 'Body' 'Attachments' 479 | :Case 2.1 ⍝ 'To' 'Subj' 'Body' {'MIMEType'} 480 | args←,⊆args 481 | (To Subj Body MIMEType)←4↑args,(≢args)↓'' '' '' '' 482 | :Else 483 | 'Invalid constructor argument'⎕SIGNAL 11 484 | :EndSelect 485 | ∇ 486 | 487 | ∇ (rc msg text)←Compose;addHeader;haveAtts;boundary;mime;body;atts;i;n;att 488 | :Access public 489 | ⍝ Compose email content 490 | (rc msg text)←¯1 '' '' 491 | :If 0∊⍴From ⋄ →Exit⊣msg←'"From" is not defined' ⋄ :EndIf 492 | :If 0∊⍴Subj ⋄ →Exit⊣msg←'"Subj" is not defined' ⋄ :EndIf 493 | :If (0∊⍴Body)∧0∊⍴Attachments ⋄ →Exit⊣msg←'No body or attachments are defined' ⋄ :EndIf 494 | MakeRecipients 495 | :If 0∊⍴Recipients ⋄ →Exit⊣msg←'No recipients are defined' ⋄ :EndIf 496 | 497 | addHeader←{ 498 | ⍵∧.=' ':'' 499 | 128∧.>⎕UCS ⍵:⍺,': ',⍵,⎕UCS 13 10 500 | ⍺,': =?utf-8?B?',(base64enc ⍵),'?=',⎕UCS 13 10 501 | } 502 | 503 | text←'Date'addHeader now ⍝ Internet-conform date first 504 | text,←'From'addHeader normalizeAddr From ⍝ the user's name & mail address 505 | text,←'Reply-To'addHeader normalizeAddr ReplyTo ⍝ the reply-to address 506 | text,←'Organization'addHeader Org 507 | text,←'X-Mailer'addHeader XMailer 508 | text,←'MIME-Version'addHeader'1.0' 509 | text,←∊CRLF∘(,⍨)¨('B'≠⊃¨Recipients)/Recipients ⍝ no headers for BCC recipients 510 | text,←'Subject'addHeader Subj ⍝ the message subject 511 | 512 | :If haveAtts←~0∊⍴Attachments ⍝ Any attachments? 513 | boundary←'------',(∊⍕¨⎕TS),'.DyalogSMTP',CRLF ⍝ construct a boundary for attachments 514 | text,←'Content-Type'addHeader'multipart/mixed; boundary="',(¯2↓boundary),'"' 515 | text,←CRLF 516 | text,←'This is a multi-part message in MIME format.',CRLF 517 | text,←'--',boundary 518 | :EndIf 519 | 520 | :If ~0∊⍴Body 521 | (mime body)←¯2↑'' '',⊆Body 522 | :If Body beginsWith'file://' 523 | body←⊃⎕NGET 7↓Body 524 | :EndIf 525 | :If 0∊⍴mime 526 | mime←(1+',4ZI2,<.>,ZI3'⎕FMT 1 5⍴2↓⎕TS ⍝ make an arbitrary one 582 | :Else 583 | name←∊¯2↑⎕NPARTS file←(7×'file://'≡7↑file)↓file 584 | :If 0∊⍴content ⍝ attempt to read content 585 | content←ReadFile file 586 | :EndIf 587 | :EndIf 588 | r←'' 589 | :If ~0∊⍴content 590 | :If 0∊⍴mime ⋄ mime←'application/octet-stream' ⋄ :EndIf 591 | r←'Content-Type: ',mime,'; name="',name,'"',CRLF 592 | r,←'Content-Transfer-Encoding: base64',CRLF 593 | r,←'Content-Disposition: attachment; filename="',name,'"',CRLF,CRLF 594 | r,←chunk base64enc content 595 | :EndIf 596 | ∇ 597 | 598 | ∇ r←ReadFile file 599 | r←{0::'' ⋄ {(⎕NUNTIE ⍵)⊢⎕NREAD ⍵,(⎕DR' '),¯1 0},⍵ ⎕NTIE 0}file 600 | ∇ 601 | 602 | ∇ MakeRecipients;addrs 603 | :Access public 604 | _recipients←'' 605 | _recipients,←'To'FormatList To 606 | _recipients,←'CC'FormatList CC 607 | _recipients,←'BCC'FormatList BCC 608 | ∇ 609 | 610 | ∇ list←type FormatList list 611 | :Access public shared 612 | ⍝ list may be a matrix, a simple (delimited) vector, or a vector of vectors 613 | :If ~0∊⍴list 614 | :If 2=≢⍴list ⍝ matrix of names? 615 | list←↓list 616 | :ElseIf (≡list)∊0 1 617 | list←list((~∊)⊆⊣)',;' ⍝ otherwise split on ; or , 618 | :EndIf 619 | list←{⍵↓⍨-+/∧\' '=⌽⍵}¨list 620 | list←(type,': ')∘,¨normalizeAddr¨list 621 | :EndIf 622 | ∇ 623 | 624 | ∇ r←CRLF 625 | :Access public shared 626 | r←⎕UCS 13 10 627 | ∇ 628 | 629 | ∇ r←{len}chunk content;breaks;mask;stuff 630 | :Access public shared 631 | ⍝ Convert content into a vector with embedded cr/lf plus dot-stuffing 632 | ⍝ len : the maximum line length, excluding cr/lf line ends. Defaults to 72, 633 | ⍝ as 74 is a safe line length to transmit through SMTP 634 | ⍝ rc : A string with cr/lf every len characters and dot-stuffing 635 | ⍝ NOTE: It is safe to send a Base64-encoded string through this function, 636 | ⍝ as those strings do not contain any dots. However, the function does 637 | ⍝ not work well if there are cr/lf already present in the input. 638 | ⍝ Dot-Stuffing: The end of an SMTP mail text is indicated by transmitting 639 | ⍝ a line with a single dot. This means, that the original 640 | ⍝ mail text must not contain a single dot on a line by itself. 641 | ⍝ To prevent this, every line that starts with a dot get's 642 | ⍝ preceeded with a second dot, which will be removed by the 643 | ⍝ recipients mail client. See pop3_unstuff, the reverse function. 644 | 645 | stuff←{'.'=⊃⍵:'.',⍵ ⋄ ⍵} 646 | 647 | :If 900⌶⍬ ⋄ len←72 ⋄ :EndIf ⍝ default line length, if not given 648 | :If 2>|≡content ⍝ simple array? otherwise, treat it as a vector of vectors 649 | :Select ≢⍴content 650 | :Case 0 651 | content←,⊂,content 652 | :Case 1 653 | :If ∨/CRLF∊content ⍝ any line breaks? 654 | content,⍨←CRLF 655 | breaks←CRLF∘.=content 656 | content←(~∘⊂CRLF)¨content⊂⍨(∨⌿breaks)≠breaks[2;]∧¯1↓0,breaks[1;] ⍝ break on CRLF or lone CR or lone LF 657 | :Else 658 | content←,⊂content 659 | :EndIf 660 | :Case 2 661 | content←↓content 662 | :Else 663 | content←↓((×/¯1↓⍴content),¯1↑⍴content)⍴content 664 | :EndSelect 665 | :EndIf 666 | 667 | content←{⍵↓⍨-⊥⍨' '=⍵}¨content ⍝ delete trailing blanks 668 | content←stuff¨content ⍝ dot-stuff (double leading dot) 669 | 670 | :If ∨/mask←len<≢¨content ⍝ any lines longer than length? 671 | :If 1=≢content ⍝ single chunk 672 | content←{((≢⍵)⍴len↑1)⊂⍵}⊃content 673 | (1↓content)←stuff¨1↓content 674 | :Else 675 | content←({⊂len∘chunk ⍵}@{mask})content 676 | :EndIf 677 | :EndIf 678 | r←∊content,¨⊂CRLF 679 | ∇ 680 | 681 | ∇ r←extractAddr addr;quotes;ind;del 682 | :Access public shared 683 | ⍝ extract the mail address from a string 684 | ⍝ perform very cursory validation on the address 685 | ⍝ addr - the string to be validated (can be in form "Fred Bloggs" fred@bloggs.com) 686 | ⍝ r - the email address or empty if not valid 687 | r←'' 688 | quotes←(⊢∨≠\)'"'=addr ⍝ mask out quoted material e.g. "fred@work" fred@bloggs.com 689 | ind←⊃⍸quotes'≢(⊣/,⊢/)a←extractAddr addr 701 | addr←(addr/⍨~∨\⌽<\⌽a⍷addr),'<',a,'>' 702 | :EndIf 703 | :EndIf 704 | ∇ 705 | 706 | ∇ r←base64 w 707 | ⍝ from dfns workspace 708 | :Access public shared 709 | r←{⎕IO ⎕ML←0 1 ⍝ Base64 encoding and decoding as used in MIME. 710 | chars←'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/' 711 | bits←{,⍉(⍺⍴2)⊤⍵} ⍝ encode each element of ⍵ in ⍺ bits, 712 | ⍝ and catenate them all together 713 | part←{((⍴⍵)⍴⍺↑1)⊂⍵} ⍝ partition ⍵ into chunks of length ⍺ 714 | 0=2|⎕DR ⍵:2∘⊥∘(8∘↑)¨8 part{(-8|⍴⍵)↓⍵}6 bits{(⍵≠64)/⍵}chars⍳⍵ 715 | ⍝ decode a string into octets 716 | four←{ ⍝ use 4 characters to encode either 717 | 8=⍴⍵:'=='∇ ⍵,0 0 0 0 ⍝ 1, 718 | 16=⍴⍵:'='∇ ⍵,0 0 ⍝ 2 719 | chars[2∘⊥¨6 part ⍵],⍺ ⍝ or 3 octets of input 720 | } 721 | cats←⊃∘(,/)∘((⊂'')∘,) ⍝ catenate zero or more strings 722 | cats''∘four¨24 part 8 bits ⍵ 723 | }w 724 | ∇ 725 | 726 | ∇ b64←base64enc txt 727 | :Access public shared 728 | b64←base64'UTF-8'⎕UCS txt 729 | ∇ 730 | 731 | ∇ txt←base64dec b64 732 | :Access public shared 733 | txt←'UTF-8'⎕UCS base64 b64 734 | ∇ 735 | 736 | ∇ rc←now;time;day;mon;s;x;LOCTIME;TIMEZONE;isUnicode;twid 737 | :Access public shared 738 | ⍝ returns an internet-conforming (RFC 5322) timestamp 739 | :If 'Win'≡3↑⊃'.'⎕WG'APLVersion' 740 | isUnicode←80=⎕DR'A' 741 | twid←64 32[1+isUnicode] ⍝ set width for text elements based on unicode or not 742 | 'LOCTIME'⎕NA'KERNEL32.C32|GetLocalTime >{I2[8]}' ⍝ associate GetLocalTime function 743 | 'TIMEZONE'⎕NA'U4 KERNEL32.C32|GetTimeZoneInformation >{I4 T[',(⍕twid),'] {I2[8]} I4 T[',(⍕twid),'] {I2[8]} I4}' ⍝ associate GetTimeZone function 744 | ⍝ prepare values for time formatting 745 | day←'Sun,' 'Mon,' 'Tue,' 'Wed,' 'Thu,' 'Fri,' 'Sat,' 746 | mon←'Jan ' 'Feb ' 'Mar ' 'Apr ' 'May ' 'Jun ' 'Jul ' 'Aug ' 'Sep ' 'Oct ' 'Nov ' 'Dec ' 747 | ⍝ read the local time and format to Internet standard 748 | time←⊃LOCTIME⊂8⍴1000 749 | rc←(1+time[3])⊃day 750 | rc←rc,,'< >,ZI2,< >'⎕FMT time[4] 751 | rc←rc,time[2]⊃mon 752 | rc←rc,,'I4,< >,ZI2,<:>,ZI2,<:>,ZI2,< >'⎕FMT 1 4⍴time[1 5 6 7] 753 | ⍝ call timezone function and calculate offset from GMT 754 | x←TIMEZONE⊂0(twid⍴' ')(8⍴0)0(twid⍴' ')(8⍴0)0 755 | x←(1⌈⊃x),2⊃x ⍝ 1⌈ to accomodate timezones that do not recognize daylight savings time 756 | s←'+-'[1+0>x←(-2⊃x)+-x[(5 8)[⊃x]]] 757 | rc←rc,s,,'ZI4,< (UTC)>'⎕FMT|100×x÷60 758 | :Else 759 | rc←1⊃⎕SH'date -R' ⍝ unix - call date command 760 | :EndIf 761 | ∇ 762 | 763 | ∇ r←Config 764 | ⍝ returns current message configuration 765 | :Access public 766 | r←↑{⍵(⍎⍵)}¨⎕THIS⍎'⎕NL ¯2.2 ¯2.3' 767 | ∇ 768 | 769 | beginsWith←{⍵≡(≢⍵)↑⍺} 770 | :EndClass 771 | 772 | :section Conga 773 | ∇ (rc msg)←Init rootname;ref;root;nc;class;dyalog;n;ns;congaCopied 774 | (rc msg)←¯1 '' 775 | ⍝↓↓↓ Check is LDRC exists (VALUE ERROR (6) if not), and is LDRC initialized? (NONCE ERROR (16) if not) 776 | :Hold 'SMTPInit' 777 | :If {6 16 999::1 ⋄ ''≡LDRC:1 ⋄ 0⊣LDRC.Describe'.'}'' 778 | LDRC←'' 779 | :If 9=#.⎕NC'Conga' ⋄ {#.Conga.X509Cert.LDRC←''}⍬ ⋄ :EndIf ⍝ if #.Conga exists, reset X509Cert.LDRC reference 780 | :If ~0∊⍴CongaRef ⍝ did the user supply a reference to Conga? 781 | LDRC←rootname ResolveCongaRef CongaRef 782 | :If ''≡LDRC 783 | msg←'CongaRef (',(⍕CongaRef),') does not point to a valid instance of Conga' 784 | →Exit 785 | :EndIf 786 | :Else 787 | :For root :In ##.## # 788 | ref nc←root{1↑¨⍵{(×⍵)∘/¨⍺ ⍵}⍺.⎕NC ⍵}ns←(-~0∊⍴rootname)↓'Conga' 'DRC' ⍝ if rootname is supplied, can only use Conga (no DRC) 789 | :If 9=⊃⌊nc ⋄ :Leave ⋄ :EndIf 790 | :EndFor 791 | :If 9=⊃⌊nc 792 | LDRC←rootname ResolveCongaRef root⍎∊ref 793 | :If ''≡LDRC 794 | msg←(⍕root),'.',(∊ref),' does not point to a valid instance of Conga' 795 | →Exit 796 | :EndIf 797 | →∆COPY↓⍨{999::0 ⋄ 1⊣LDRC.Describe'.'}'' ⍝ it's possible that Conga was saved in a semi-initialized state 798 | :Else 799 | ∆COPY: 800 | class←⊃⊃⎕CLASS ⎕THIS 801 | dyalog←{⍵,'/'↓⍨'/\'∊⍨¯1↑⍵}2 ⎕NQ'.' 'GetEnvironment' 'DYALOG' 802 | congaCopied←0 803 | :For n :In ns 804 | :Trap 0 805 | n class.⎕CY dyalog,'ws/conga' 806 | LDRC←rootname ResolveCongaRef class⍎n 807 | :If ''≡LDRC 808 | msg←n,' was copied from [DYALOG]/ws/conga, but is not valid' 809 | →Exit 810 | :EndIf 811 | congaCopied←1 812 | :Leave 813 | :EndTrap 814 | :EndFor 815 | :If ~congaCopied 816 | msg←'Neither Conga nor DRC were successfully copied from [DYALOG]/ws/conga' 817 | →Exit 818 | :EndIf 819 | :EndIf 820 | :EndIf 821 | :EndIf 822 | rc←¯1×LDRC≢'' 823 | Exit: 824 | :EndHold 825 | ∇ 826 | 827 | ∇ LDRC←rootname ResolveCongaRef CongaRef;z;failed 828 | ⍝ CongaRef could be a charvec, reference to the Conga or DRC namespaces, or reference to an iConga instance 829 | ⍝ :Access public shared ⍝!!! testing only - remove :Access after testing 830 | LDRC←'' ⋄ failed←0 831 | :Select ⎕NC⊂'CongaRef' ⍝ what is it? 832 | :Case 9.1 ⍝ namespace? e.g. CongaRef←DRC or Conga 833 | Try: 834 | :Trap 0 835 | :If ∨/'.Conga'⍷⍕CongaRef ⍝ is it Conga? 836 | LDRC←CongaRef.Init rootname 837 | :ElseIf 0≡⊃CongaRef.Init'' ⍝ DRC? 838 | LDRC←CongaRef 839 | :Else 840 | →0⊣LDRC←'' 841 | :End 842 | :Else ⍝ if HttpCommand is reloaded and re-executed in rapid succession, Conga initialization may fail, so we try twice 843 | :If failed 844 | →0⊣LDRC←'' 845 | :Else 846 | →Try⊣failed←1 847 | :EndIf 848 | :EndTrap 849 | :Case 9.2 ⍝ instance? e.g. CongaRef←Conga.Init '' 850 | LDRC←CongaRef ⍝ an instance is already initialized 851 | :Case 2.1 ⍝ variable? e.g. CongaRef←'#.Conga' 852 | :Trap 0 853 | LDRC←ResolveCongaRef(⍎∊⍕CongaRef) 854 | :EndTrap 855 | :EndSelect 856 | ∇ 857 | :endsection 858 | 859 | :EndClass 860 | --------------------------------------------------------------------------------