patch d280db07c18bbe0bee399bd33a23c813c6215823 Author: Enrique D. Bosch Date: Tue Dec 4 23:41:31 CET 2018 * Add support for SNI patch a960193b96b178a92741ceb58850f17b29629c95 Author: Enrique D. Bosch Date: Tue Dec 4 21:12:31 CET 2018 * Simplify parser of configuration file patch 3994fdd764ce973cd13650e4fd820083d9e8b2b5 Author: Enrique D. Bosch Date: Tue Dec 4 20:53:19 CET 2018 * Add title to password dialog patch e8534a5cb083b3d82aff297783e2c5d2d683c8d3 Author: Enrique D. Bosch Date: Mon Sep 17 16:50:09 CEST 2018 * Reset client keepalive when server keepalive (untagged "OK still here" like response) is detected patch 0b7e378659f9aec5eff13490775050929649bda2 Author: Enrique D. Bosch Date: Sat Sep 8 21:34:57 CEST 2018 * Set icon to hourglass when the connection is lost and reconnecting patch 459541a83671f7510008f6add9eed8e5502ea6d3 Author: Enrique D. Bosch Date: Thu Sep 6 01:00:58 CEST 2018 * Move reset idle to exit_idle patch bd7e29cb071eb7be716e9bb785540882402845f3 Author: Enrique D. Bosch Date: Wed Sep 5 19:21:16 CEST 2018 * Set icon to hourglass when checking mail (searching) and waiting for logout patch 54015fb789a93e0b2f72a72ded21190f68fc4f59 Author: Enrique D. Bosch Date: Tue Sep 4 21:38:00 CEST 2018 * Replace question mark icon with hourglass patch 0e5aa389db90fbbc6e6b9515acd3aa92c94731a7 Author: Enrique D. Bosch Date: Tue Sep 4 19:32:19 CEST 2018 * Move non-logout code to cleanup function patch 3eb89bff44a913b4c504d590cf62cd9c47dd3936 Author: Enrique D. Bosch Date: Tue Sep 4 19:17:08 CEST 2018 * For logout, exit from idle mode only when it is patch 7eb7e2ff46a284866aa04fa8679ec731279c63c7 Author: Enrique D. Bosch Date: Sun Sep 2 21:20:08 CEST 2018 * Implement correctly LOGOUT command according to RFC 3501, add logout_timeout config option patch dc30edb7135409c41683a29f0a23684e7805693c Author: Enrique D. Bosch Date: Sun Sep 2 19:44:50 CEST 2018 * Use defaulted argument in imap_command_tagged function, ifempty function not necessary patch 1fa87126792bb5a286620f7604fe9c0affd81637 Author: Enrique D. Bosch Date: Fri Aug 31 22:07:57 CEST 2018 * Simplify ifempty function patch c10ef6fde35c32a02b4d6ceb7731589dd6e207a0 Author: Enrique D. Bosch Date: Fri Aug 31 21:32:14 CEST 2018 * Simplify interface for imap_command_tagged function patch 564fe5aa95af90b3fb9e3d522c114fecd249b914 Author: Enrique D. Bosch Date: Fri Aug 31 00:48:30 CEST 2018 * Set some defaults for missing config options patch 6cb864e02d9646202d1c02fce406e57ba2059f46 Author: Enrique D. Bosch Date: Thu Aug 30 00:52:43 CEST 2018 * Add imap_trace option to show IMAP protocol dialog patch 55c1cbaf4c675e24f783478cf8aaa869449f3c17 Author: Enrique D. Bosch Date: Fri Aug 24 22:40:19 CEST 2018 * Add error wrapper, later can be a window dialog or something patch c074e25fdf925ae76c798e8303f50d1509e2ac79 Author: Enrique D. Bosch Date: Thu Sep 7 00:08:44 CEST 2017 * Simplify or, and procs patch d6716f5f719e0e6b712139717e6df63ca44fd4db Author: Enrique D. Bosch Date: Tue Sep 5 22:19:09 CEST 2017 * Fix style to avoid double substitution patch dd4031d5b1d6adb28dec8dd4ebef7e6da146ce12 Author: Enrique D. Bosch Date: Thu Aug 17 02:18:12 CEST 2017 * Add tag to LOGIN command in debug omiting the credentials (commented) patch 16034f2b6f19369d43dc6b1c91c184734f75185a Author: Enrique D. Bosch Date: Wed Jan 11 01:00:25 CET 2017 * Change expressions from infix to prefix notation patch 2b11c67e9dd039c4f3bce6bf120363cfc66bd5d4 Author: Enrique D. Bosch Date: Tue Jan 3 20:44:31 CET 2017 * Improve capabilities parsing, remove initial noop by default patch c70c6d824c3dc25edbb1417483f26cbb303dbc80 Author: Enrique D. Bosch Date: Tue Jan 3 19:53:17 CET 2017 * Improve parsing in IDLE mode patch 6c43ff2e14364f2547e281a6e97b9ddbe1645f81 Author: Enrique D. Bosch Date: Tue Dec 13 23:21:49 CET 2016 * Simplify regular expressions patch 61926820804dbe5661d868d10142ef8ce839735b Author: Enrique D. Bosch Date: Tue Dec 13 22:03:31 CET 2016 * Fix end-of-line character handling patch 3d92c90730176e9d354ceba7423397306f7196f3 Author: Enrique D. Bosch Date: Mon Nov 28 00:54:07 CET 2016 * Correct tls_validate_cert config option (was forced to 1 even when set to 0) patch abecc24572d6c212ae41f2d9617b225433422c4c Author: Enrique D. Bosch Date: Tue Nov 22 23:55:46 CET 2016 * Remove unused variable patch 6dd64c777afb2deec0c3dcfacbba3552e409ead6 Author: Enrique D. Bosch Date: Tue Nov 22 23:26:40 CET 2016 * Handle multiline SEARCH responses (according to http://imapwiki.org/ClientImplementation/Search) patch 287378ffe6ada32c8197ae2c266578bf469f554e Author: Enrique D. Bosch Date: Wed Nov 16 23:03:15 CET 2016 * Wait for response of SEARCH (get the number of messages) before sending the IDLE command patch 83b5d85caf2a4557ec715816e73d43b4a9b8ac06 Author: Enrique D. Bosch Date: Wed Nov 16 21:33:45 CET 2016 * Add config option "criteria" for IMAP SEARCH criteria (UNSEEN by default) patch 5511dcb92b2c3f22d8aaf1cdcb93de720aa6eee1 Author: Enrique D. Bosch Date: Sat Nov 12 19:01:49 CET 2016 * Remove unnecessary braces patch ea4b60e19dd0d98535541f44247b8821d9c16d06 Author: Enrique D. Bosch Date: Fri Sep 9 21:09:18 CEST 2016 * Add output for debugging (commented) patch ebc8d6d2521391e4354381e0396671bb7d41852d Author: Enrique D. Bosch Date: Fri Sep 9 12:51:40 CEST 2016 * Improve/fix reconnection functionality patch aa141d8d814fb6fda062d68c9250359ca41438ec Author: Enrique D. Bosch Date: Wed Jun 8 15:35:03 CEST 2016 * Fix style and operators of some expressions patch 734e04efcdbee633dd1621cd32d7327e62819e6c Author: Enrique D. Bosch Date: Wed Jun 8 11:34:39 CEST 2016 * Strip unused braces and lines patch 7cf737ec305ade9759d13a9fa2f5ef70b6158c45 Author: Enrique D. Bosch Date: Wed Jun 8 00:14:13 CEST 2016 * Add an option (tls_ca_subject) to check the subject of the root certificate, to avoid attacks with leaf certificates generated by compromissed or malicious certificate authorities, this is a key pinning mechanism patch 80544e6a2108d1f5387f5fd676b89c934181460d Author: Enrique D. Bosch Date: Wed Jun 8 00:00:48 CEST 2016 * Improve parser of configuration file patch 7338b38e3656d3cfd65724e679fefc686d08e9b2 Author: Enrique D. Bosch Date: Sun Jun 5 23:26:38 CEST 2016 * Fix options passed to tls (were not having effect) patch b0cebeb0d05720d8b145fc479b09238a463a26cf Author: Enrique D. Bosch Date: Sat Jun 4 17:05:02 CEST 2016 * Improve capabilities parse routine patch c673de820d8f38ff45a5ee81cdd1a48c1ae5a229 Author: Enrique D. Bosch Date: Wed Jun 1 01:36:58 CEST 2016 * Fix regular expressions for capabilities patch e5c973637923fda8b5c042f0135d08965c6ac2de Author: Enrique D. Bosch Date: Tue May 31 17:06:39 CEST 2016 * Support extension to SEARCH (RFC-4731) when available (via ESEARCH capability) to make UNSEEN queries more efficient diff -rN -u old-idlebiff/.idlebiffrc new-idlebiff/.idlebiffrc --- old-idlebiff/.idlebiffrc 2024-11-23 01:03:38.699018459 +0100 +++ new-idlebiff/.idlebiffrc 2024-11-23 01:03:38.699018459 +0100 @@ -10,8 +10,10 @@ mailbox=INBOX tls=1 port=993 +initial_noop=0 keepalive=1500 timeout=20 +timeout_logout=2 png_up=up.png png_down=down.png png_chk=check.png @@ -19,9 +21,12 @@ pos_y=1 tip=1 nodecor=1 +imap_trace=0 +criteria= tls_validate_cert=1 tls_ca_dir= tls_ca_file= +tls_ca_subject= tls_client_cert= tls_client_key= tls_ciphers=DEFAULT:!SSLv3 Binary files old-idlebiff/check.png and new-idlebiff/check.png differ diff -rN -u old-idlebiff/idlebiff new-idlebiff/idlebiff --- old-idlebiff/idlebiff 2024-11-23 01:03:38.699018459 +0100 +++ new-idlebiff/idlebiff 2024-11-23 01:03:38.699018459 +0100 @@ -26,14 +26,42 @@ package require png package require tooltip +namespace path ::tcl::mathop +proc or args { foreach x $args { if { $x } { return 1 } }; return 0 } +proc and args { foreach x $args { if { $x } continue { return 0 } }; return 1 } + +proc setappend { var args } { upvar 1 $var v; set v [ join $args {} ] } + +proc check_conf_and_set_default { opt default } \ +{ + variable ::shared::conf + + if {![ info exists conf($opt) ]} { set conf($opt) $default } +} + +namespace eval static \ +{ + variable ntag 1 + variable ccsp 0 + variable pmsgs 0 + variable search_resp 0 + array set ccsu {} +} -namespace eval static { variable tag 1 } namespace eval shared \ { variable idle 0 - variable idlecap 0 - variable logindiscap 0 - variable msgs 0 + array set cap \ + { + logindisabled 0 + logindisabled_chk 0 + chk 0 + idle 0 + esearch 0 + } + variable search + variable rexp_chk + variable rexpsearch variable sock variable conf array set conf {} @@ -46,9 +74,10 @@ variable img_down variable img_chk variable new_messages 0 + variable tag } -proc define_pixmaps { } \ +proc define_pixmaps {} \ { variable ::shared::img_up variable ::shared::img_down @@ -60,7 +89,7 @@ set img_chk [ image create photo -format png -file $conf(png_chk) ] } -proc icon { } \ +proc icon {} \ { variable ::shared::img_up variable ::shared::img_down @@ -79,13 +108,13 @@ set png_chk_w [ dict get $pnginfo width ] set png_chk_h [ dict get $pnginfo height ] - set size_not_same [ expr $png_up_w!=$png_down_w || $png_down_w!=$png_chk_w || $png_up_h!=$png_down_h || $png_down_h!=$png_chk_h ] - if { $size_not_same } { error } + set size_not_same [ or [ != $png_up_w $png_down_w ] [ != $png_down_w $png_chk_w ] [ != $png_up_h $png_down_h ] [ != $png_down_h $png_chk_h ] ] + if { $size_not_same } { emit_error size } wm title . idlebiff wm iconname . idlebiff - append geom [ expr $png_up_w + 10 ] x [ expr $png_up_h + 10 ] - if { $conf(pos_x) && $conf(pos_y) } { append geom + $conf(pos_x) + $conf(pos_y) } + append geom [ + $png_up_w 10 ] x [ + $png_up_h 10 ] + if {[ and $conf(pos_x) $conf(pos_y) ]} { append geom + $conf(pos_x) + $conf(pos_y) } wm geometry . $geom wm resizable . 0 0 wm overrideredirect . $conf(nodecor) @@ -104,20 +133,19 @@ bind .frame.canvas.button force_down bind .frame.canvas.button { cleanup $con } bind .frame.canvas.button { idle_cycle $con 1 } -# if { $conf(tip) } { tooltip::tooltip .frame.canvas } -# set current $img_chk } -proc get_password { bad } \ +proc get_password bad \ { variable ::shared::conf upvar #0 pass pass - if $bad { set textbad "WRONG PASSWORD\n" } \ - else { set textbad "" } - if !$conf(tls) { set nv "\nWARNING: INSECURE CONNECTION" } + if { $bad } { set textbad "WRONG PASSWORD\n" } \ + else { set textbad {} } + if { !$conf(tls) } { set nv "\nWARNING: INSECURE CONNECTION" } toplevel .tl + wm title .tl {idlebiff: password} message .tl.msg -bg black -fg yellow -width 400 -justify center \ -text "${textbad}Enter password for\n$conf(user) at $conf(host)" pack .tl.msg -side top -fill both @@ -135,32 +163,67 @@ return $p } -proc update_img { img } \ +proc update_img img \ { variable ::shared::conf variable ::shared::new_messages .frame.canvas.button configure -image $img - if $conf(tip) { tooltip::tooltip .frame.canvas $new_messages } + if { $conf(tip) } { tooltip::tooltip .frame.canvas $new_messages } } -proc read_conf { } \ +proc read_conf {} \ { upvar #0 argv arg argc argn variable ::shared::conf - if { $argn==1 } { set config $arg } else { set config "$::env(HOME)/.idlebiffrc" } + if {[ == $argn 1 ]} { set config $arg } else { set config "$::env(HOME)/.idlebiffrc" } set cf [ open $config ] - while { [ gets $cf lin ] >= 0 } \ + while {[ >= [ gets $cf lin ] 0 ]} \ { - if { [ string range [ string trim $lin ] 0 0 ] == "#" } { continue } + if {[ == [ string index [ string trim $lin ] 0 ] # ]} continue set lconf [ split $lin = ] - lassign $lconf key val + set val [ join [ lassign $lconf key ] = ] set conf([ string trim $key]) [ string trim $val ] } } -proc set_timeout { } \ +proc set_params {} \ +{ + variable ::shared::rexp_chk + + check_conf_and_set_default criteria UNSEEN + check_conf_and_set_default nodecor 1 + check_conf_and_set_default tip 0 + check_conf_and_set_default tls 0 + check_conf_and_set_default tls_validate_cert 1 + check_conf_and_set_default initial_noop 0 + check_conf_and_set_default imap_trace 0 + set rexp_chk {(?: |\[)capability } +} + +proc set_search_params {} \ +{ + variable ::shared::cap + variable ::shared::search + variable ::shared::rexpsearch + variable ::shared::conf + + if { $cap(esearch) } \ + { + set search "SEARCH RETURN (COUNT) $conf(criteria)" + set rexpsearch {^\* esearch \(tag [^)]*\) count (.*)$} + } \ + else \ + { + set search "SEARCH $conf(criteria)" + set rexpsearch {^\* search((?: .*|$))} + } +} + +proc emit_error args { error $args } + +proc set_timeout {} \ { variable ::shared::conf variable ::shared::tevent @@ -168,6 +231,7 @@ set tevent($teidf) [ after ${conf(timeout)}000 \ { + update_img $::shared::img_chk cancel_timeout close $con init @@ -176,12 +240,12 @@ incr teidf } -proc cancel_timeout { } \ +proc cancel_timeout {} \ { variable ::shared::tevent variable ::shared::teidi - if [ info exists tevent($teidi) ] \ + if {[ info exists tevent($teidi) ]} \ { after cancel $tevent($teidi) unset tevent($teidi) @@ -191,7 +255,7 @@ proc exec_terse { com args } \ { - if [ catch { set res [ eval "$com [ join $args]" ] } ] \ + if {[ catch { set res [ eval "$com [ join $args]" ] } ]} \ { set terse [ split $::errorInfo "\n" ] puts [ join [ lrange $terse 0 0 ] ] @@ -200,18 +264,29 @@ return $res } -proc recon { con } \ +proc recon con \ { variable ::shared::ka + variable ::shared::idle + variable ::shared::img_chk after cancel $ka - close $con + update_img $img_chk + set idle 0 + catch { close $con } after 3000 init } proc imap_command { con com } \ { - if [ catch { puts -nonewline $con "$com\r\n" } ] \ + variable ::shared::conf + + if { $conf(imap_trace) } \ + { if {[ regexp {.*LOGIN.*} $com ]} { puts "C: [string range $com 0 10]" } else { puts "C: $com" } } + + set r [ catch { puts $con $com } ] + if {[ eq $com LOGOUT ]} return + if { $r } \ { recon $con return @@ -219,265 +294,390 @@ set_timeout } -proc imap_command_tagged { con com } \ +proc imap_command_tagged { con com { prefix A } } \ { - variable ::static::tag + variable ::static::ntag + variable ::shared::tag - if { $tag == 10000 } { set tag 1 } - append tcom A [ format %04d $tag ] " " $com + if {[ == $ntag 10000 ]} { set ntag 1 } + setappend tag $prefix [ format %04d $ntag ] + append tcom $tag { } $com imap_command $con $tcom - incr tag + incr ntag } -proc ok_tagged { linea } \ +proc ok_tagged { linea { tag {A\d+} } } \ { - return [ regexp -lineanchor -nocase {^A\d+\s+ok.*$} $linea ] + append rexp {^} $tag { ok.*$} + return [ regexp -lineanchor -nocase $rexp $linea ] } -proc ok_untagged { linea } \ +proc ok_untagged linea \ { - return [ regexp -lineanchor -nocase {^\*\s+ok.*$} $linea ] + return [ regexp -lineanchor -nocase {^\* ok.*$} $linea ] } -proc no_tagged { linea } \ +proc no_tagged linea \ { - return [ regexp -lineanchor -nocase {^A\d+\s+no.*$} $linea ] + return [ regexp -lineanchor -nocase {^A\d+ no.*$} $linea ] } proc login { con retr } \ { variable ::shared::conf - variable ::shared::logindiscap + variable ::shared::cap - if $logindiscap { error logindisabled } + if { $cap(logindisabled) } { emit_error logindisabled } - if $retr { unset conf(pass) } - if ![ info exists conf(pass) ] { set conf(pass) [ get_password $retr ] } + if { $retr } { unset conf(pass) } + if { ![ info exists conf(pass) ] } { set conf(pass) [ get_password $retr ] } imap_command_tagged $con "LOGIN $conf(user) $conf(pass)" } -proc logout { con } \ +proc logout con \ { + variable ::shared::conf + + fileevent $con readable { parse_logout $con } + after ${conf(timeout_logout)}000 \ + { + close $con + exit 0 + } imap_command_tagged $con LOGOUT - close $con } -proc cleanup { con } \ +proc cleanup con \ { + variable ::shared::ka + variable ::shared::img_chk + variable ::shared::idle + + update_img $img_chk + after cancel $ka + if { $idle } { exit_idle $con } logout $con - exit 0 } -proc force_down { } \ +proc force_down {} \ { variable ::shared::img_down update_img $img_down } -proc enter_idle { con } \ +proc enter_idle con \ { - imap_command_tagged $con IDLE + imap_command_tagged $con IDLE } -proc exit_idle { con } \ +proc exit_idle con \ { + variable ::shared::idle + + set idle 0 imap_command $con DONE } -proc enter_mailbox { con } \ +proc enter_mailbox con \ { variable ::shared::conf imap_command_tagged $con "EXAMINE $conf(mailbox)" } -proc exit_mailbox { con } \ +proc exit_mailbox con \ { imap_command_tagged $con CLOSE } -proc ask_unseen { con } \ -{ - imap_command_tagged $con "SEARCH UNSEEN" -} - -proc check_cap_logindis { linea } \ +proc do_search con \ { - variable ::shared::logindiscap + variable ::shared::search + variable ::shared::img_chk - if !$logindiscap { set logindiscap [ regexp -nocase {.*capability .* logindisabled .*} $linea ] } + update_img $img_chk + imap_command_tagged $con $search } -proc check_cap_idle { linea } \ +proc check_cap { linea args } \ { - variable ::shared::idlecap + variable ::shared::cap + variable ::shared::rexp_chk - if !$idlecap { set idlecap [ regexp -nocase {.*capability .* idle .*} $linea ] } + if {[ regexp -nocase -lineanchor $rexp_chk $linea ]} \ + { + if {[ eq $args logindisabled ]} { set cap(logindisabled_chk) 1 } \ + else { set cap(chk) 1 } + foreach capname $args \ + { + if { !$cap($capname) } \ + { + set rexp_cap " ${capname}(?: |]|$)" + set cap($capname) [ regexp -nocase -lineanchor $rexp_cap $linea ] + } + } + } } proc idle_cycle { con check } \ { - variable ::shared::idle variable ::shared::conf variable ::shared::ka after cancel $ka - set idle 0 exit_idle $con - if $check { ask_unseen $con } - enter_idle $con + if { $check } { do_search $con } \ + else { enter_idle $con } set ka [ after ${conf(keepalive)}000 { idle_cycle $con 0 } ] } -proc init_idle { con } \ +proc init_idle con \ { variable ::shared::conf variable ::shared::ka + variable ::shared::cap + if { !$cap(idle) } { emit_error noidle } fileevent $con readable { parse_idle_check $con } enter_mailbox $con - ask_unseen $con - enter_idle $con + set_search_params + do_search $con set ka [ after ${conf(keepalive)}000 { idle_cycle $con 0 } ] } -proc parse_greeting { con } \ +proc parse_greeting con \ { + variable ::shared::cap + set linea [ read_line $con ] - check_cap_logindis $linea - if [ ok_untagged $linea ] { fileevent $con readable { parse_noop $con } } + check_cap $linea logindisabled + if {[ ok_untagged $linea ]} \ + { + if { $cap(logindisabled_chk) } \ + { + fileevent $con readable { parse_login $con } + login $con 0 + } \ + else \ + { + fileevent $con readable { parse_logindisabled $con } + imap_command_tagged $con CAPABILITY + } + } } -proc parse_noop { con } \ +proc parse_logindisabled con \ { + variable ::shared::cap set linea [ read_line $con ] - check_cap_logindis $linea - if [ ok_tagged $linea ] \ + check_cap $linea logindisabled + if {[ ok_tagged $linea ]} \ { - fileevent $con readable { parse_login $con } - login $con 0 + if { $cap(logindisabled_chk) } \ + { + fileevent $con readable { parse_login $con } + login $con 0 + } } } -proc parse_login { con } \ +proc parse_login con \ { - variable ::shared::idlecap + variable ::shared::cap set linea [ read_line $con ] - check_cap_idle $linea - if [ ok_tagged $linea ] \ + check_cap $linea idle esearch + if {[ ok_tagged $linea ]} \ { - if $idlecap { init_idle $con } \ + if { $cap(chk) } { init_idle $con } \ else \ { fileevent $con readable { parse_cap $con } imap_command_tagged $con CAPABILITY } } \ - elseif [ no_tagged $linea ] { login $con 1 } + elseif {[ no_tagged $linea ]} { login $con 1 } } -proc parse_cap { con } \ +proc parse_cap con \ { - variable ::shared::idlecap - set linea [ read_line $con ] - check_cap_idle $linea - if [ ok_tagged $linea ] \ - { - if $idlecap { init_idle $con } \ - else { error no idle capability } \ - } + check_cap $linea idle esearch + if {[ ok_tagged $linea ]} { init_idle $con } } -proc parse_idle_check { con } \ +proc parse_idle_check con \ { variable ::shared::idle + variable ::shared::ka + variable ::shared::conf - set linea [ read_line $con ] + if {[ catch { set linea [ read_line $con ] } ]} return set prim [ string range $linea 0 0 ] - if { $prim eq "+" } { set idle 1 } \ - elseif { $idle==1 } { idle_cycle $con 1 } \ - else { parse_unseen $linea } + if {[ eq $prim + ]} { set idle 1 } \ + elseif { $idle } \ + { + if {[ eq $prim * ]} \ + { + if {[ ok_untagged $linea ]} \ + { + after cancel $ka + set ka [ after ${conf(keepalive)}000 { idle_cycle $con 0 } ] + } \ + else { idle_cycle $con 1 } \ + } \ + } \ + else { parse_search $con $linea } } -proc parse_unseen { linea } \ +proc parse_search { con linea } \ { variable ::shared::conf variable ::shared::img_up variable ::shared::img_down variable ::shared::new_messages + variable ::shared::cap + variable ::shared::rexpsearch + variable ::static::pmsgs + variable ::static::search_resp - if [ regexp -lineanchor -nocase {^\*\s+search\s+(.*)$} $linea -> msg_list ] \ + if {[ regexp -lineanchor -nocase $rexpsearch $linea -> res ]} \ + { + if { $cap(esearch) } { set pmsgs $res } else { incr pmsgs [ llength $res ] } + set search_resp 1 + } + if {[ and $search_resp [ ok_tagged $linea ] ]} \ { - set new_messages [ llength $msg_list ] - if { $new_messages > 0 } \ + enter_idle $con + set new_messages $pmsgs + set pmsgs 0 + set search_resp 0 + if {[ > $new_messages 0 ]} \ { set current $img_up } \ else { set current $img_down } update_img $current - } + } + if {[ no_tagged $linea ]} { emit_error search } +} + +proc parse_logout con \ +{ + variable ::shared::conf + variable ::shared::tag + + if {[ catch { gets $con linea } ]} return + if { $conf(imap_trace) } { puts "S: $linea" } + if {[ ok_tagged $linea $tag ]} \ + { + close $con + exit 0 + } } -proc read_line { con } \ +proc read_line con \ { + variable ::shared::conf + cancel_timeout - if [ catch { set r [ gets $con line ] } ] \ + if {[ catch { set r [ gets $con line ] } ]} \ { recon $con - return + return -code error } - if [ regexp -lineanchor -nocase {^\*\s+bye .*$} $line ] \ + if {[ regexp -lineanchor -nocase {^\* bye(?: .*|$)} $line ]} \ { recon $con - return + return -code error } - if { $r<1 && [ eof $con ] } \ + if {[ and [ < $r 1 ] [ eof $con ] ]} \ { recon $con + return -code error } \ - else { return $line } + else \ + { + if { $conf(imap_trace) } { puts "S: $line" } + + return $line + } } +proc parse_cert_subject sub \ +{ + set cst [ split [ string map { , = / = } $sub ] = ] + foreach v $cst { lappend cstp [ string trim $v ] } + return $cstp +} + +proc tls_cb { type channel depth cert status error } \ +{ + variable ::shared::conf + variable ::static::ccsu + variable ::static::ccsp + + array set ca $cert + if {[ info exists conf(tls_ca_subject) ]} \ + { + if {[ and [ ne $conf(tls_ca_subject) {} ] [ eq $type verify ] [ eq $ca(subject) $ca(issuer) ] ]} \ + { + array set csu [ parse_cert_subject $ca(subject) ] + if { !$ccsp } \ + { + array set ccsu [ parse_cert_subject $conf(tls_ca_subject) ] + set ccsp 1 + } + foreach i [ array names ccsu ] \ + { + if { ![ info exists csu($i) ] } { emit_error cert } + if {[ ne $csu($i) $ccsu($i) ]} { emit_error cert } + } + } + } +} -proc init_tls { } \ +proc init_tls {} \ { variable ::shared::conf variable ::shared::sock - if $conf(tls) \ + if { $conf(tls) } \ { set tlsv [ package require tls ] - if {"$tlsv">="1.6.4"} { set tls1x {-tls1.1 1 -tls1.2 1} } \ + if {[ >= $tlsv 1.6.4 ]} { set tls1x {-tls1.1 1 -tls1.2 1} } \ else { set tls1x {} } - ::tls::init -ssl2 0 -ssl3 0 -tls1 1 [ list $tls1x ] \ - -cafile "$conf(tls_ca_file)" \ - -cadir "$conf(tls_ca_dir)" \ - -certfile "$conf(tls_client_cert)" \ - -keyfile "$conf(tls_client_key)" \ - -request 1 \ - -require "$conf(tls_validate_cert)" \ - -cipher "$conf(tls_ciphers)" - set sock ::tls::socket + if {[ info exists conf(sni) ]} { set sni "-servername $conf(sni)" } \ + else { set sni {} } + set sock "::tls::socket -ssl2 0 -ssl3 0 -tls1 1 $tls1x \ + -cafile \"$conf(tls_ca_file)\" \ + -cadir \"$conf(tls_ca_dir)\" \ + -certfile \"$conf(tls_client_cert)\" \ + -keyfile \"$conf(tls_client_key)\" \ + -request \"$conf(tls_validate_cert)\" \ + -require \"$conf(tls_validate_cert)\" \ + -cipher \"$conf(tls_ciphers)\" \ + $sni \ + -command tls_cb" } \ else { set sock socket } -} +} -proc init { } \ +proc init {} \ { upvar #0 con con variable ::shared::conf variable ::shared::sock set con [ exec_terse $sock -async $conf(host) $conf(port) ] - fconfigure $con -blocking 0 -buffering line + fconfigure $con -blocking 0 -buffering line -translation {crlf crlf} fileevent $con readable { parse_greeting $con } - imap_command_tagged $con NOOP + if { $conf(initial_noop) } { imap_command_tagged $con NOOP N } } read_conf +set_params icon init_tls init