idlebiff
patch b9e1a59375fcf26841ae8132aa84471114dcd7c9
Author: Enrique D. Bosch <presidev@AT@gmail.com>
Date: Sun May 29 02:23:48 CEST 2016
* Initial record
diff -rN -u old-idlebiff/idlebiff new-idlebiff/idlebiff
--- old-idlebiff/idlebiff 1970-01-01 01:00:00.000000000 +0100
+++ new-idlebiff/idlebiff 2024-05-19 05:25:51.200321313 +0200
@@ -0,0 +1,490 @@
+#!/usr/bin/tclsh
+
+# idlebiff: check for new mail in an IMAP account using IDLE extension
+# the notifications arrives as soon as there is new mail
+# Copyright (C) 2016 Enrique D. Bosch 'presi'
+
+# idlebiff is based on the ideas of xbiff and imapbiff but the code is
+# entirely rewritten
+
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+package require Tk
+package require crc32
+package require tkpng
+package require png
+package require tooltip
+
+
+namespace eval static { variable tag 1 }
+namespace eval shared \
+{
+ variable idle 0
+ variable idlecap 0
+ variable logindiscap 0
+ variable msgs 0
+ variable sock
+ variable conf
+ array set conf {}
+ variable tevent
+ array set tevent {}
+ variable teidi 0
+ variable teidf 0
+ variable ka 0
+ variable img_up
+ variable img_down
+ variable img_chk
+ variable new_messages 0
+}
+
+proc define_pixmaps { } \
+{
+ variable ::shared::img_up
+ variable ::shared::img_down
+ variable ::shared::img_chk
+ variable ::shared::conf
+
+ set img_up [ image create photo -format png -file $conf(png_up) ]
+ set img_down [ image create photo -format png -file $conf(png_down) ]
+ set img_chk [ image create photo -format png -file $conf(png_chk) ]
+}
+
+proc icon { } \
+{
+ variable ::shared::img_up
+ variable ::shared::img_down
+ variable ::shared::img_chk
+ variable ::shared::conf
+
+ set pnginfo [ ::png::imageInfo $conf(png_up) ]
+ set png_up_w [ dict get $pnginfo width ]
+ set png_up_h [ dict get $pnginfo height ]
+
+ set pnginfo [ ::png::imageInfo $conf(png_down) ]
+ set png_down_w [ dict get $pnginfo width ]
+ set png_down_h [ dict get $pnginfo height ]
+
+ set pnginfo [ ::png::imageInfo $conf(png_chk) ]
+ 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 }
+
+ 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) }
+ wm geometry . $geom
+ wm resizable . 0 0
+ wm overrideredirect . $conf(nodecor)
+
+ frame .frame
+ pack .frame -expand 1 -fill both
+ canvas .frame.canvas -width $png_up_w -height $png_up_h -bd 10 -relief sunken
+ pack .frame.canvas -expand 1 -fill both
+
+ define_pixmaps
+
+ button .frame.canvas.button -image $img_chk -cursor left_ptr
+ .frame.canvas create window 0 0 -window .frame.canvas.button -anchor nw
+ pack .frame.canvas.button -expand 1 -fill both
+
+ bind .frame.canvas.button <Button-1> force_down
+ bind .frame.canvas.button <Button-2> { cleanup $con }
+ bind .frame.canvas.button <Button-3> { idle_cycle $con 1 }
+# if { $conf(tip) } { tooltip::tooltip .frame.canvas }
+# set current $img_chk
+}
+
+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" }
+
+ toplevel .tl
+ 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
+ entry .tl.entry -relief sunken -bg grey -fg black -width 30 -show *
+ pack .tl.entry -side top
+ button .tl.bok -text OK -padx 20 -command { set pass [ .tl.entry get ]; destroy .tl }
+ pack .tl.bok -side right
+ bind .tl.entry <Return> { .tl.bok invoke }
+ button .tl.bc -text Cancel -command { cleanup $con } -padx 20
+ pack .tl.bc -side left
+ focus .tl.entry
+ vwait pass
+ set p $pass
+ unset pass
+ return $p
+}
+
+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 }
+}
+
+proc read_conf { } \
+{
+ upvar #0 argv arg argc argn
+ variable ::shared::conf
+
+ if { $argn==1 } { set config $arg } else { set config .idlebiffrc }
+ set cf [ open $config ]
+ while { [ gets $cf lin ] >= 0 } \
+ {
+ if { [ string range [ string trim $lin ] 0 0 ] == "#" } { continue }
+ set lconf [ split $lin = ]
+ lassign $lconf key val
+ set conf([ string trim $key]) [ string trim $val ]
+ }
+}
+
+proc set_timeout { } \
+{
+ variable ::shared::conf
+ variable ::shared::tevent
+ variable ::shared::teidf
+
+ set tevent($teidf) [ after ${conf(timeout)}000 \
+ {
+ cancel_timeout
+ close $con
+ init
+ } \
+ ]
+ incr teidf
+}
+
+proc cancel_timeout { } \
+{
+ variable ::shared::tevent
+ variable ::shared::teidi
+
+ if [ info exists tevent($teidi) ] \
+ {
+ after cancel $tevent($teidi)
+ unset tevent($teidi)
+ incr teidi
+ }
+}
+
+proc exec_terse { com args } \
+{
+ if [ catch { set res [ eval "$com [ join $args]" ] } ] \
+ {
+ set terse [ split $::errorInfo "\n" ]
+ puts [ join [ lrange $terse 0 0 ] ]
+ exit 1
+ }
+ return $res
+}
+
+proc recon { con } \
+{
+ variable ::shared::ka
+
+ after cancel $ka
+ close $con
+ after 3000 init
+}
+
+proc imap_command { con com } \
+{
+ if [ catch { puts -nonewline $con "$com\r\n" } ] \
+ {
+ recon $con
+ return
+ }
+ set_timeout
+}
+
+proc imap_command_tagged { con com } \
+{
+ variable ::static::tag
+
+ if { $tag == 10000 } { set tag 1 }
+ append tcom A [ format %04d $tag ] " " $com
+ imap_command $con $tcom
+ incr tag
+}
+
+proc ok_tagged { linea } \
+{
+ return [ regexp -lineanchor -nocase {^A\d+\s+ok.*$} $linea ]
+}
+
+proc ok_untagged { linea } \
+{
+ return [ regexp -lineanchor -nocase {^\*\s+ok.*$} $linea ]
+}
+
+proc no_tagged { linea } \
+{
+ return [ regexp -lineanchor -nocase {^A\d+\s+no.*$} $linea ]
+}
+
+proc login { con retr } \
+{
+ variable ::shared::conf
+ variable ::shared::logindiscap
+
+ if $logindiscap { error logindisabled }
+
+ 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 } \
+{
+ imap_command_tagged $con LOGOUT
+ close $con
+}
+
+proc cleanup { con } \
+{
+ logout $con
+ exit 0
+}
+
+proc force_down { } \
+{
+ variable ::shared::img_down
+
+ update_img $img_down
+}
+
+proc enter_idle { con } \
+{
+ imap_command_tagged $con IDLE
+}
+
+proc exit_idle { con } \
+{
+ imap_command $con DONE
+}
+
+proc enter_mailbox { con } \
+{
+ variable ::shared::conf
+
+ imap_command_tagged $con "EXAMINE $conf(mailbox)"
+}
+
+proc exit_mailbox { con } \
+{
+ imap_command_tagged $con CLOSE
+}
+
+proc ask_unseen { con } \
+{
+ variable ::shared::conf
+
+ imap_command_tagged $con "STATUS $conf(mailbox) (UNSEEN)"
+}
+
+proc check_cap_logindis { linea } \
+{
+ variable ::shared::logindiscap
+
+ if !$logindiscap { set logindiscap [ regexp -nocase {.*capability .* logindisabled .*} $linea ] }
+}
+
+proc check_cap_idle { linea } \
+{
+ variable ::shared::idlecap
+
+ if !$idlecap { set idlecap [ regexp -nocase {.*capability .* idle .*} $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 \
+ {
+ exit_mailbox $con
+ ask_unseen $con
+ enter_mailbox $con
+ }
+ enter_idle $con
+ set ka [ after ${conf(keepalive)}000 { idle_cycle $con 0 } ]
+}
+
+proc init_idle { con } \
+{
+ variable ::shared::conf
+ variable ::shared::ka
+
+ fileevent $con readable { parse_idle $con }
+ ask_unseen $con
+ enter_mailbox $con
+ enter_idle $con
+ set ka [ after ${conf(keepalive)}000 { idle_cycle $con 0 } ]
+}
+
+proc parse_greeting { con } \
+{
+ set linea [ read_line $con ]
+ check_cap_logindis $linea
+ if [ ok_untagged $linea ] { fileevent $con readable { parse_noop $con } }
+}
+
+proc parse_noop { con } \
+{
+
+ set linea [ read_line $con ]
+ check_cap_logindis $linea
+ if [ ok_tagged $linea ] \
+ {
+ fileevent $con readable { parse_login $con }
+ login $con 0
+ }
+}
+
+proc parse_login { con } \
+{
+ variable ::shared::idlecap
+
+ set linea [ read_line $con ]
+ check_cap_idle $linea
+ if [ ok_tagged $linea ] \
+ {
+ if $idlecap { init_idle $con } \
+ else \
+ {
+ fileevent $con readable { parse_cap $con }
+ imap_command_tagged $con CAPABILITY
+ }
+ } \
+ elseif [ no_tagged $linea ] { login $con 1 }
+}
+
+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 } \
+ }
+}
+
+proc parse_idle { con } \
+{
+ variable ::shared::idle
+ variable ::shared::msgs
+ variable ::shared::conf
+ variable ::shared::img_up
+ variable ::shared::img_down
+ variable ::shared::new_messages
+
+ set linea [ read_line $con ]
+ set prim [ string range $linea 0 0 ]
+ if { $prim eq "+" } { set idle 1 } \
+ elseif { $idle==1 } { idle_cycle $con 1 } \
+ else \
+ {
+ append statusexp {^\*\s+status\s+} {"*} $conf(mailbox) {"*} {\s+\(unseen\s+(\d+)\).*$}
+ if [ regexp -lineanchor -nocase $statusexp $linea -> new_messages ] \
+ {
+ if { $new_messages > 0 } \
+ { set current $img_up } \
+ else { set current $img_down }
+ update_img $current
+ }
+ }
+}
+
+proc read_line { con } \
+{
+ cancel_timeout
+ if [ catch { set r [ gets $con line ] } ] \
+ {
+ recon $con
+ return
+ }
+ if [ regexp -lineanchor -nocase {^\*\s+bye .*$} $line ] \
+ {
+ recon $con
+ return
+ }
+ if { $r<1 && [ eof $con ] } \
+ {
+ recon $con
+ } \
+ else { return $line }
+}
+
+
+proc init_tls { } \
+{
+ variable ::shared::conf
+ variable ::shared::sock
+
+ if $conf(tls) \
+ {
+ set tlsv [ package require tls ]
+ 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
+ } \
+ else { set sock socket }
+}
+
+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
+ fileevent $con readable { parse_greeting $con }
+ imap_command_tagged $con NOOP
+}
+
+read_conf
+icon
+init_tls
+init
+
+vwait forever