# $Id: s.Imap.xotcl 1.6 01/03/23 21:55:31+01:00 neumann@somewhere.wu-wien.ac.at $
package provide xotcl::comm::imap 0.9

Class Imap -superclass NetAccess -parameter {user}
Imap instproc initialize args {
  [self] instvar port caching tokenCounter resp token
  set port 143
  set caching 1
  set resp(connect)       {"[*] OK" login}
  set resp(login)         {"A[0-9]+ OK" loginFinished  "A[0-9]+ NO" login}
  set resp(loginFinished) {"[*] [0-9]+" inboxSize "[*] OK" inboxSelected}
  set resp(mailSelected)  {"[*] [0-9]+ FETCH" fetchBody 
                           "A[0-9]+ OK " ignoreLine
                           "[*] " ignoreLine}
  set resp(heads)         {"[*] [0-9]+ FETCH" fetchHeaders 
                           "A[0-9]+ OK " ignoreLine
                           "[*] " ignoreLine}
  set tokenCounter 0
  next
  set token NONE
}
Imap instproc err {state reply} {
  [self] abort "Error in $state: $reply"
}
Imap instproc token {} {
  [self] instvar tokenCounter
  return [format {A%.4d} [incr tokenCounter]]
}
Imap instproc imapString {input} {
  regsub -all {(["\])} $input {\\\1} output ;#"
  return \"$output\"
}
Imap instproc queryServer {query state} {
  #[self] showCall
  [self] instvar S token
  set token [[self] token]
  puts $S "$token $query"
  #puts stderr "$token $query"
  flush $S
  fileevent $S readable [list [self] response $state]
}
Imap instproc response {state} {
  [self] instvar S resp msg token
  set msg [gets $S]
  #[self] showVars msg token
  foreach {c newState} $resp($state) {
    if {![regexp {^[*]} $msg] && ![regexp ^$token $msg]} {
      [self] showMsg "$state: token=$token IGNORING $msg"
      return
    }
    if {[regexp ^$c $msg]} {
      #[self] showMsg "$state NEWSTATE $newState"
      return [[self] $newState] 
    }
  }
  [self] err $state "expected=$resp($state), got $msg"
}
Imap instproc GET {} {
  [self] instvar state S path host port user inbox mailNr
  # number at end of path is the message number in the mailbox
  if {[regexp {^([^/]+)/([^/]+)/([0-9]+)$} $path _ user inbox mailNr]} {
  } elseif {[regexp {^([^/]+)/([^/]+)/?$} $path _ user inbox]} {
  } else {
    [self] abort "invalid imap path $path"
  }
  regexp {^(.*):([0-9]+)$} $host _ host port
  # proxy ?
  if {[catch {set S [socket -async $host $port]} err]} {
    [self] abort "Could not open connection to host '$host:$port'\n    $err"
  } else {
    fconfigure $S -blocking false 
    fileevent $S readable [list [self] response connect]
  }
}
Imap instproc login {} {
  [self] instvar user host password
  if {[pwdManager requirePasswd "Imap $user\@$host" $user password]} {
    [self] queryServer "login $user [[self] imapString $password]" login
  } else {
    what now?
  }
}
Imap instproc loginFinished {} {
  [self] instvar user host password inbox
  pwdManager storePasswd "Imap $user\@$host" $user $password
  [self] queryServer "select $inbox" loginFinished
}
Imap instproc inboxSize {} {
  [self] instvar msg nrMails
  regexp {^[*] ([0-9]+) EXISTS} $msg _ nrMails
}
Imap instproc inboxSelected {} {
  [self] instvar msg contentType nrMails mailNr
  if {[info exists mailNr]} {
    set contentType text/plain
    [self] body-state
    [self] queryServer "fetch $mailNr rfc822" mailSelected
  } else {
    [self] instvar header inbox block host user block
    set contentType text/html
    [self] body-state
    set what "Mailbox $inbox of $user@$host"
    set block "<HTML><HEAD><TITLE>$what</TITLE></HEAD>\n"
    append block "<BODY><H1>$what</H1>\n" \
	"The following <i>$nrMails</i> messages are in this mailbox:" \
	"<p>\n<UL>\n"
    [self] pushBlock
    catch {unset header}
    set mailNr $nrMails
    [self] queryServer "fetch $nrMails body\[header\]" heads
  }
}
Imap instproc ignoreLine {} {;}
Imap instproc fetchBody {} {
  [self] instvar S
  fileevent $S readable [list [self] bodyContent]
}
Imap instproc bodyContent {} {
  [self] instvar S block msg
  set msg [gets $S]
  if {$msg == ")"} {
    [self] set state eof
    [self] finish
  } else {
    set block $msg\n
    [self] pushBlock
  }
}
Imap instproc fetchHeaders {} {
  [self] instvar S
  fileevent $S readable [list [self] headContent]
}
Imap instproc headContent {} {
  [self] instvar S token header nrMails mailNr block host user inbox
  set msg [gets $S]
  if {[regexp -nocase {^([^:]+): *(.+)$} $msg _ key value]} {
    set key [string tolower $key]
    set header($mailNr,$key) $value
  } elseif {$msg == ")"} {
    # mail header finished
    set block "<LI> Message $mailNr from $header($mailNr,date)<br>\ 
	<A HREF=\"imap://$host/$user/$inbox/$mailNr\">"
    if {[catch {set from $header($mailNr,from)}]} {
      if {[catch {set from $header($mailNr,sender)}]} {	set from UNKNOWN }
    }
    if {[regexp {[(](.*)[)]} $from _ x]} { 
    } elseif {[regexp {[<](.*)[>]} $from _ x]} { 
    } else  { set x $from }
    append block $x ": "
    if {[info exists header($mailNr,subject)]} { append block $header($mailNr,subject) }
    append block </A><P>
    [self] pushBlock
    if {$mailNr > 1} {
      incr mailNr -1
      [self] queryServer "fetch $mailNr body\[header\]" heads
    } else {
      set block "</UL></BODY></HTML>\n"
      [self] pushBlock
      [self] set state eof
      [self] finish
    }
  }
}
