( email.lib -- Library for sending e-mail using Proto socket primitives )
(
  To configure the SMTP server:
     @set $lib/email=smtp-server:furscape.wherever.com
     @propset $lib/email=int:smtp-port:25
  
  W3 permissions are required to call this library successfully!
  
  To send an e-mail using 'sendmail', you need the following arguments
  on the stack . . .
    TO address: Name1 <user1@domain.com>, Name2 <user2@domain.com>
    FROM address: Name <user@domain.com>
    SUBJECT line: Any string will do.
    CONTENTS: An array in which each element is a text string.
    
  Multiple destinatons are OK, but addresses must be in <angle brackets> or
  the program will get confused and will FAIL.  Currently it only returns 1
  for success or 0 if the messages failed to get sent.  To figure out why
  it's failing, use the debugger.
  
  Note that mail takes some time to send, at least several seconds each.
  This is because the MUF has to wait for each response back from the
  SMTP server, and 1 second is the shortest time that a MUF program can
  wait in the current versions of ProtoMUCK.
)
 
LVAR Socket
LVAR Player
LVAR SendTo
LVAR SendFrom
LVAR Subject
LVAR Contents
 
: get-SMTP-response  ( SOCK -- i )
  (input: socket connected to a SMTP server)
  (output: SMTP reply code, or 0 if connection was lost)
  
  1 10 1 for pop
    dup nbsockrecv  ( +socket connection $incoming )
    swap not if
      (connection gone)
      pop 0  ( +socket 0 )
      break
    then
    ( +socket $incoming )
    dup if
      atoi   ( +socket code )
      break
    else
      (no response from socket yet...)
      pop  ( +socket )
    then
    1 sleep
  repeat
  ( +socket code )
  swap pop  ( code )
;
 
: sendmail  ( s s s a - i )
  (inputs: $to, $from, $subject, [contents])
  (output: success code 1=success, 0=failed)
  
  (Save args into variables, keep stack clean.)
  Contents !   ( array containing lines of text )
  Subject !    ( subject line )
  SendFrom !   ( address that mail will come from )
  SendTo !     ( address or addresses that mail will go to )
  
  (First open our socket connection to the SMTP server!)
  prog "smtp-server" getpropstr dup not if
    pop "silverden.com"
  then
  prog "smtp-port" getpropval dup not if
    pop 25
  then
  ( $smtp-address smtp-port )
  nbsockopen  ( +socket $err )
  "Operation now in progress" .samestring? not if
    (it wasn't openable)
    pop 0 exit
  then
  Socket !
  
  (Now sockcheck it.)
  1 10 1 for pop
    Socket @ sockcheck  ( status )
    dup 1 = if
      (conection is good!)
      pop break
    then
    dup -1 = if
      (connection was refused)
      pop 4 popn exit
    then
    pop   (we're still waiting)
    1 sleep
  repeat
  
  (We have an open, operating socket!)
  
  Socket @ get-SMTP-response  ( 220 = Service Ready )
  220 = not if 0 exit then
  
  Socket @ "HELO furscape" socksend not if 0 exit then
  Socket @ get-SMTP-response  ( 250 = Command completed )
  250 = not if 0 exit then
  
  (extract the basic e-mail origin address)
  SendFrom @ "<" .split swap pop ">" .split pop
  "MAIL FROM: <addy>" swap "addy" subst
  Socket @ swap socksend not if 0 exit then
  Socket @ get-SMTP-response
  250 = not if 0 exit then  ( 250 = Command completed )
  
  (extract the basic e-mail destination addresses)
  SendTo @
  begin "<" .split dup while
    swap pop ">" .split swap  ( $remainder $addy )
    "RCPT TO: <addy>" swap "addy" subst
    Socket @ swap socksend not if pop 0 exit then
    Socket @ get-SMTP-response
    250 = not if pop 0 exit then  ( 250 = Command completed )
  repeat
  pop pop
  
  (open data entry to send mail body)
  Socket @ "DATA" socksend not if 0 exit then
  Socket @ get-SMTP-response
  354 = not if pop 0 exit then  ( 354 = enter mail )
  
  (mail header data first!)
  Socket @ "X-Mailer: ProtoMUCK" socksend not if 0 exit then
  Socket @ "From: " SendFrom @ strcat socksend not if 0 exit then
  Socket @ "To: " SendTo @ strcat socksend not if 0 exit then
  Socket @ "Subject: " Subject @ strcat socksend not if 0 exit then
  
  Contents @ foreach
    ( index $line )
    swap pop  ( $line )
    
    (transparency code - prepend . to any line that starts with .)
    dup 1 strcut pop  ( $line $firstchar )
    "." .samestring? if
      "." swap strcat
    then
    
    Socket @ swap socksend not if 0 exit then
  repeat
  
  (close out the data command)
  Socket @ "." socksend not if 0 exit then
  Socket @ get-SMTP-response
  250 = not if pop 0 exit then  ( 250 = Command completed )
  
  (close the SMTP connection)
  Socket @ "QUIT" socksend not if 0 exit then
  Socket @ get-SMTP-response
  221 = not if pop 0 exit then  ( 221 = Closing connection )
  
  (cleanup after the session)
  Socket @ sockclose pop
  1  (return true, since the mail appears to have gone out)
;
 
PUBLIC sendmail
 
(
  @set $lib/email=_defs/sendmail:"$lib/email" match "sendmail" call
)