/usr/share/tcltk/xotcl1.6.7-comm/Imap.xotcl is in xotcl 1.6.7-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 | # $Id: Imap.xotcl,v 1.4 2006/02/18 22:17:33 neumann Exp $
package provide xotcl::comm::imap 0.9
package require XOTcl
namespace eval ::xotcl::comm::imap {
package require xotcl::comm::httpAccess
namespace import ::xotcl::*
Class Imap -superclass NetAccess -parameter {user}
Imap instproc initialize args {
my 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} {
my abort "Error in $state: $reply"
}
Imap instproc token {} {
my instvar tokenCounter
return [format {A%.4d} [incr tokenCounter]]
}
Imap instproc imapString {input} {
regsub -all {(["\])} $input {\\\1} output ;#"
return \"$output\"
}
Imap instproc queryServer {query state} {
#my showCall
my instvar S token
set token [my token]
puts $S "$token $query"
#puts stderr "$token $query"
flush $S
fileevent $S readable [list [self] response $state]
}
Imap instproc response {state} {
my instvar S resp msg token
set msg [gets $S]
#my showVars msg token
foreach {c newState} $resp($state) {
if {![regexp {^[*]} $msg] && ![regexp ^$token $msg]} {
my showMsg "$state: token=$token IGNORING $msg"
return
}
if {[regexp ^$c $msg]} {
#my showMsg "$state NEWSTATE $newState"
return [my $newState]
}
}
my err $state "expected=$resp($state), got $msg"
}
Imap instproc GET {} {
my 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 {
my abort "invalid imap path $path"
}
regexp {^(.*):([0-9]+)$} $host _ host port
# proxy ?
if {[catch {set S [socket -async $host $port]} err]} {
my 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 {} {
my instvar user host password
if {[pwdManager requirePasswd "Imap $user\@$host" $user password]} {
my queryServer "login $user [my imapString $password]" login
} else {
what now?
}
}
Imap instproc loginFinished {} {
my instvar user host password inbox
pwdManager storePasswd "Imap $user\@$host" $user $password
my queryServer "select $inbox" loginFinished
}
Imap instproc inboxSize {} {
my instvar msg nrMails
regexp {^[*] ([0-9]+) EXISTS} $msg _ nrMails
}
Imap instproc inboxSelected {} {
my instvar msg contentType nrMails mailNr
if {[info exists mailNr]} {
set contentType text/plain
my body-state
my queryServer "fetch $mailNr rfc822" mailSelected
} else {
my instvar header inbox block host user block
set contentType text/html
my 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"
my pushBlock
catch {unset header}
set mailNr $nrMails
my queryServer "fetch $nrMails body\[header\]" heads
}
}
Imap instproc ignoreLine {} {;}
Imap instproc fetchBody {} {
my instvar S
fileevent $S readable [list [self] bodyContent]
}
Imap instproc bodyContent {} {
my instvar S block msg
set msg [gets $S]
if {$msg == ")"} {
my set state 4
my finish
} else {
set block $msg\n
my pushBlock
}
}
Imap instproc fetchHeaders {} {
my instvar S
fileevent $S readable [list [self] headContent]
}
Imap instproc headContent {} {
my 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>
my pushBlock
if {$mailNr > 1} {
incr mailNr -1
my queryServer "fetch $mailNr body\[header\]" heads
} else {
set block "</UL></BODY></HTML>\n"
my pushBlock
my set state 4
my finish
}
}
}
namespace export Imap
}
namespace import ::xotcl::comm::imap::*
|