Add error wrapper, later can be a window dialog or something --> to head
patch d280db07c18bbe0bee399bd33a23c813c6215823
Author: Enrique D. Bosch <presidev@AT@gmail.com>
Date: Tue Dec 4 23:41:31 CET 2018
* Add support for SNI
patch a960193b96b178a92741ceb58850f17b29629c95
Author: Enrique D. Bosch <presidev@AT@gmail.com>
Date: Tue Dec 4 21:12:31 CET 2018
* Simplify parser of configuration file
patch 3994fdd764ce973cd13650e4fd820083d9e8b2b5
Author: Enrique D. Bosch <presidev@AT@gmail.com>
Date: Tue Dec 4 20:53:19 CET 2018
* Add title to password dialog
patch e8534a5cb083b3d82aff297783e2c5d2d683c8d3
Author: Enrique D. Bosch <presidev@AT@gmail.com>
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 <presidev@AT@gmail.com>
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 <presidev@AT@gmail.com>
Date: Thu Sep 6 01:00:58 CEST 2018
* Move reset idle to exit_idle
patch bd7e29cb071eb7be716e9bb785540882402845f3
Author: Enrique D. Bosch <presidev@AT@gmail.com>
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 <presidev@AT@gmail.com>
Date: Tue Sep 4 21:38:00 CEST 2018
* Replace question mark icon with hourglass
patch 0e5aa389db90fbbc6e6b9515acd3aa92c94731a7
Author: Enrique D. Bosch <presidev@AT@gmail.com>
Date: Tue Sep 4 19:32:19 CEST 2018
* Move non-logout code to cleanup function
patch 3eb89bff44a913b4c504d590cf62cd9c47dd3936
Author: Enrique D. Bosch <presidev@AT@gmail.com>
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 <presidev@AT@gmail.com>
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 <presidev@AT@gmail.com>
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 <presidev@AT@gmail.com>
Date: Fri Aug 31 22:07:57 CEST 2018
* Simplify ifempty function
patch c10ef6fde35c32a02b4d6ceb7731589dd6e207a0
Author: Enrique D. Bosch <presidev@AT@gmail.com>
Date: Fri Aug 31 21:32:14 CEST 2018
* Simplify interface for imap_command_tagged function
patch 564fe5aa95af90b3fb9e3d522c114fecd249b914
Author: Enrique D. Bosch <presidev@AT@gmail.com>
Date: Fri Aug 31 00:48:30 CEST 2018
* Set some defaults for missing config options
patch 6cb864e02d9646202d1c02fce406e57ba2059f46
Author: Enrique D. Bosch <presidev@AT@gmail.com>
Date: Thu Aug 30 00:52:43 CEST 2018
* Add imap_trace option to show IMAP protocol dialog
patch 55c1cbaf4c675e24f783478cf8aaa869449f3c17
Author: Enrique D. Bosch <presidev@AT@gmail.com>
Date: Fri Aug 24 22:40:19 CEST 2018
* Add error wrapper, later can be a window dialog or something
diff -rN -u old-idlebiff/.idlebiffrc new-idlebiff/.idlebiffrc
--- old-idlebiff/.idlebiffrc 2024-11-22 21:40:00.762468034 +0100
+++ new-idlebiff/.idlebiffrc 2024-11-22 21:40:00.766468027 +0100
@@ -13,6 +13,7 @@
initial_noop=0
keepalive=1500
timeout=20
+timeout_logout=2
png_up=up.png
png_down=down.png
png_chk=check.png
@@ -20,6 +21,7 @@
pos_y=1
tip=1
nodecor=1
+imap_trace=0
criteria=
tls_validate_cert=1
tls_ca_dir=
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-22 21:40:00.766468027 +0100
+++ new-idlebiff/idlebiff 2024-11-22 21:40:00.766468027 +0100
@@ -30,9 +30,18 @@
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 tag 1
+ variable ntag 1
variable ccsp 0
variable pmsgs 0
variable search_resp 0
@@ -53,7 +62,6 @@
variable search
variable rexp_chk
variable rexpsearch
- variable criteria
variable sock
variable conf
array set conf {}
@@ -66,6 +74,7 @@
variable img_down
variable img_chk
variable new_messages 0
+ variable tag
}
proc define_pixmaps {} \
@@ -100,7 +109,7 @@
set png_chk_h [ dict get $pnginfo height ]
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 } { error }
+ if { $size_not_same } { emit_error size }
wm title . idlebiff
wm iconname . idlebiff
@@ -136,6 +145,7 @@
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
@@ -172,21 +182,23 @@
while {[ >= [ gets $cf lin ] 0 ]} \
{
if {[ == [ string index [ string trim $lin ] 0 ] # ]} continue
- set sep [ string first = $lin ]
- set key [ string range $lin 0 [ - $sep 1 ] ]
- set val [ string range $lin [ + $sep 1 ] end ]
+ set lconf [ split $lin = ]
+ set val [ join [ lassign $lconf key ] = ]
set conf([ string trim $key]) [ string trim $val ]
}
}
proc set_params {} \
{
- variable ::shared::conf
- variable ::shared::criteria
variable ::shared::rexp_chk
- if {[ info exists conf(criteria) ]} { if {[ ne $conf(criteria) {} ]} { set criteria $conf(criteria) } } \
- else { set criteria UNSEEN }
+ 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 }
}
@@ -195,20 +207,22 @@
variable ::shared::cap
variable ::shared::search
variable ::shared::rexpsearch
- variable ::shared::criteria
+ variable ::shared::conf
if { $cap(esearch) } \
{
- set search "SEARCH RETURN (COUNT) $criteria"
+ set search "SEARCH RETURN (COUNT) $conf(criteria)"
set rexpsearch {^\* esearch \(tag [^)]*\) count (.*)$}
} \
else \
{
- set search "SEARCH $criteria"
+ set search "SEARCH $conf(criteria)"
set rexpsearch {^\* search((?: .*|$))}
}
}
+proc emit_error args { error $args }
+
proc set_timeout {} \
{
variable ::shared::conf
@@ -217,6 +231,7 @@
set tevent($teidf) [ after ${conf(timeout)}000 \
{
+ update_img $::shared::img_chk
cancel_timeout
close $con
init
@@ -253,8 +268,10 @@
{
variable ::shared::ka
variable ::shared::idle
+ variable ::shared::img_chk
after cancel $ka
+ update_img $img_chk
set idle 0
catch { close $con }
after 3000 init
@@ -262,8 +279,14 @@
proc imap_command { con com } \
{
-# if {[regexp {.*LOGIN.*} $com]} {puts "C: [string range $com 0 10]"} else {puts "C: $com"}
- if {[ catch { puts $con $com } ]} \
+ 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
@@ -271,19 +294,21 @@
set_timeout
}
-proc imap_command_tagged { con prefix 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 $prefix [ 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 prefix } \
+proc ok_tagged { linea { tag {A\d+} } } \
{
- append rexp {^} $prefix {\d+ ok.*$}
+ append rexp {^} $tag { ok.*$}
return [ regexp -lineanchor -nocase $rexp $linea ]
}
@@ -302,24 +327,37 @@
variable ::shared::conf
variable ::shared::cap
- if { $cap(logindisabled) } { error logindisabled }
+ if { $cap(logindisabled) } { emit_error logindisabled }
if { $retr } { unset conf(pass) }
if { ![ info exists conf(pass) ] } { set conf(pass) [ get_password $retr ] }
- imap_command_tagged $con A "LOGIN $conf(user) $conf(pass)"
+ imap_command_tagged $con "LOGIN $conf(user) $conf(pass)"
}
proc logout con \
{
- imap_command_tagged $con A LOGOUT
- close $con
+ variable ::shared::conf
+
+ fileevent $con readable { parse_logout $con }
+ after ${conf(timeout_logout)}000 \
+ {
+ close $con
+ exit 0
+ }
+ imap_command_tagged $con LOGOUT
}
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 {} \
@@ -331,11 +369,14 @@
proc enter_idle con \
{
- imap_command_tagged $con A IDLE
+ imap_command_tagged $con IDLE
}
proc exit_idle con \
{
+ variable ::shared::idle
+
+ set idle 0
imap_command $con DONE
}
@@ -343,19 +384,21 @@
{
variable ::shared::conf
- imap_command_tagged $con A "EXAMINE $conf(mailbox)"
+ imap_command_tagged $con "EXAMINE $conf(mailbox)"
}
proc exit_mailbox con \
{
- imap_command_tagged $con A CLOSE
+ imap_command_tagged $con CLOSE
}
proc do_search con \
{
variable ::shared::search
+ variable ::shared::img_chk
- imap_command_tagged $con A $search
+ update_img $img_chk
+ imap_command_tagged $con $search
}
proc check_cap { linea args } \
@@ -380,12 +423,10 @@
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 } { do_search $con } \
else { enter_idle $con }
@@ -398,7 +439,7 @@
variable ::shared::ka
variable ::shared::cap
- if { !$cap(idle) } { error noidle }
+ if { !$cap(idle) } { emit_error noidle }
fileevent $con readable { parse_idle_check $con }
enter_mailbox $con
set_search_params
@@ -422,7 +463,7 @@
else \
{
fileevent $con readable { parse_logindisabled $con }
- imap_command_tagged $con A CAPABILITY
+ imap_command_tagged $con CAPABILITY
}
}
}
@@ -433,7 +474,7 @@
set linea [ read_line $con ]
check_cap $linea logindisabled
- if {[ ok_tagged $linea A ]} \
+ if {[ ok_tagged $linea ]} \
{
if { $cap(logindisabled_chk) } \
{
@@ -449,13 +490,13 @@
set linea [ read_line $con ]
check_cap $linea idle esearch
- if {[ ok_tagged $linea A ]} \
+ if {[ ok_tagged $linea ]} \
{
if { $cap(chk) } { init_idle $con } \
else \
{
fileevent $con readable { parse_cap $con }
- imap_command_tagged $con A CAPABILITY
+ imap_command_tagged $con CAPABILITY
}
} \
elseif {[ no_tagged $linea ]} { login $con 1 }
@@ -465,17 +506,30 @@
{
set linea [ read_line $con ]
check_cap $linea idle esearch
- if {[ ok_tagged $linea A ]} { init_idle $con }
+ if {[ ok_tagged $linea ]} { init_idle $con }
}
proc parse_idle_check con \
{
variable ::shared::idle
+ variable ::shared::ka
+ variable ::shared::conf
if {[ catch { set linea [ read_line $con ] } ]} return
set prim [ string range $linea 0 0 ]
if {[ eq $prim + ]} { set idle 1 } \
- elseif { $idle } { if {[ eq $prim * ]} { idle_cycle $con 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 }
}
@@ -495,7 +549,7 @@
if { $cap(esearch) } { set pmsgs $res } else { incr pmsgs [ llength $res ] }
set search_resp 1
}
- if {[ and $search_resp [ ok_tagged $linea A ] ]} \
+ if {[ and $search_resp [ ok_tagged $linea ] ]} \
{
enter_idle $con
set new_messages $pmsgs
@@ -506,11 +560,27 @@
else { set current $img_down }
update_img $current
}
- if {[ no_tagged $linea ]} { error search }
+ 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 \
{
+ variable ::shared::conf
+
cancel_timeout
if {[ catch { set r [ gets $con line ] } ]} \
{
@@ -529,7 +599,8 @@
} \
else \
{
-# puts "S: $line"
+ if { $conf(imap_trace) } { puts "S: $line" }
+
return $line
}
}
@@ -560,8 +631,8 @@
}
foreach i [ array names ccsu ] \
{
- if { ![ info exists csu($i) ] } { error cert }
- if {[ ne $csu($i) $ccsu($i) ]} { error cert }
+ if { ![ info exists csu($i) ] } { emit_error cert }
+ if {[ ne $csu($i) $ccsu($i) ]} { emit_error cert }
}
}
}
@@ -577,6 +648,8 @@
set tlsv [ package require tls ]
if {[ >= $tlsv 1.6.4 ]} { set tls1x {-tls1.1 1 -tls1.2 1} } \
else { set tls1x {} }
+ 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)\" \
@@ -585,10 +658,11 @@
-request \"$conf(tls_validate_cert)\" \
-require \"$conf(tls_validate_cert)\" \
-cipher \"$conf(tls_ciphers)\" \
+ $sni \
-command tls_cb"
} \
else { set sock socket }
-}
+}
proc init {} \
{
@@ -599,7 +673,7 @@
set con [ exec_terse $sock -async $conf(host) $conf(port) ]
fconfigure $con -blocking 0 -buffering line -translation {crlf crlf}
fileevent $con readable { parse_greeting $con }
- if { $conf(initial_noop) } { imap_command_tagged $con N NOOP }
+ if { $conf(initial_noop) } { imap_command_tagged $con NOOP N }
}
read_conf