Index: modules/imap4/ChangeLog ================================================================== --- modules/imap4/ChangeLog +++ modules/imap4/ChangeLog @@ -1,5 +1,16 @@ +2013-01-25 Andreas Kupries + + * imap4.man: Updated documentation with text contributed by Nicola + Hall, explaining the new commands. + +2013-01-22 Andreas Kupries + + * imap4.tcl: Applied contribution by Nicola Hall. + * imap4.man: Additional commands. Bumped version + * pkgIndex.tcl: to 0.4. + 2011-12-13 Andreas Kupries * * Released and tagged Tcllib 1.14 ======================== * Index: modules/imap4/imap4.man ================================================================== --- modules/imap4/imap4.man +++ modules/imap4/imap4.man @@ -1,16 +1,16 @@ -[manpage_begin imap4 n 0.3] +[manpage_begin imap4 n 0.4] [moddesc {imap client}] [titledesc {imap client-side tcl implementation of imap protocol}] [require Tcl 8.5] -[require imap4 [opt 0.3]] +[require imap4 [opt 0.4]] [description] The [package imap4] library package provides the client side of the -[strong "Internet Message Access Protocol"] (IMAP) using standard +[emph "Internet Message Access Protocol"] (IMAP) using standard sockets or secure connection via TLS/SSL. The package is fully implemented in Tcl. [para] This document describes the procedures and explains their usage. @@ -55,18 +55,18 @@ [example {{{Arc08 noselect} {Arc08/Private {noinferiors unmarked}} {INBOX noinferiors}}}] [call [cmd ::imap4::select] [arg chan] [opt [arg mailbox]]] [para]Select a mailbox, 0 is returned on success. [para][arg chan] - imap channel -[para][arg mailbox] - Path of the mailbox, defaults to [strong INBOX] +[para][arg mailbox] - Path of the mailbox, defaults to [emph INBOX] [para]Prior to examine/select an open mailbox must be closed - see: [cmd ::imap4::close]. [call [cmd ::imap4::examine] [arg chan] [opt [arg mailbox]]] [para]"Examines" a mailbox, read-only equivalent of [cmd ::imap4::select]. [para][arg chan] - imap channel [para][arg mailbox] - mailbox name or path to mailbox, -defaults to [strong INBOX] +defaults to [emph INBOX] [para]Prior to examine/select an open mailbox must be closed - see: [cmd ::imap4::close]. [call [cmd ::imap4::fetch] [arg chan] [arg range] [opt [arg -inline]] [opt [arg "attr ..."]]] [para]Fetch attributes from messages. [para]The attributes are fetched and stored in the internal state @@ -99,14 +99,14 @@ false if it is not. [para][arg chan] - imap channel [para][arg info] - folderlist options to retrieve [para] Currently supported options: -[strong delim] - hierarchy delimiter only, -[strong match] - ref and mbox search patterns (see [cmd ::imap4::folders]), -[strong names] - list of folder names only, -[strong flags] - list of folder names with flags in format +[emph delim] - hierarchy delimiter only, +[emph match] - ref and mbox search patterns (see [cmd ::imap4::folders]), +[emph names] - list of folder names only, +[emph flags] - list of folder names with flags in format [emph "{ {name {flags}} ... }"] (see also compact format in function [cmd ::imap4::folders]). [example { {{Arc08 {{\NoSelect}}} {Arc08/Private {{\NoInferiors} {\UnMarked}}} {INBOX {\NoInferiors}}} }] @@ -136,17 +136,17 @@ false if it is not. [para][arg chan] - imap channel [para][arg opt] - mailbox option to retrieve [para] Currently supported options: -[strong EXISTS] (noof msgs), -[strong RECENT] (noof 'recent' flagged msgs), -[strong FLAGS] +[emph EXISTS] (noof msgs), +[emph RECENT] (noof 'recent' flagged msgs), +[emph FLAGS] [para]In conjunction with OK: -[strong PERMFLAGS], [strong UIDNEXT], [strong UIDVAL], [strong UNSEEN] +[emph PERMFLAGS], [emph UIDNEXT], [emph UIDVAL], [emph UNSEEN] [para]Div. states: -[strong CURRENT], [strong FOUND], [strong PERM]. +[emph CURRENT], [emph FOUND], [emph PERM]. [example { ::imap4::select $chan INBOX puts "[::imap4::mboxinfo $chan exists] mails in INBOX"}] @@ -234,10 +234,59 @@ The ::imap4::debug variable is automatically set to '1' on enter. [para]It's possible to execute Tcl commands starting the line with a slash. [para][arg chan] - imap channel [para][arg errormsg] - optional error message to display + +[call [cmd ::imap4::store] [arg chan] [arg range] [arg data] [arg flaglist]] + +[para] Alters data associated with a message in the selected +mailbox. + +[para][arg chan] - imap channel +[para][arg range] - message index in format [emph FROM]:[emph TO] +[para][arg flaglist] - Flags the [arg data] operates on. +[para][arg data] - The currently defined [arg data] items that can be +stored are shown below. [emph Note] that all of these data types may +also be suffixed with ".SILENT" to suppress the untagged FETCH +response. + +[list_begin definitions] +[def FLAGS] +Replace the flags for the message (other than \Recent) with the +[arg flaglist]. +[def "+FLAGS"] +Add the flags in [arg flaglist] to the existing flags for the message. +[def "-FLAGS"] +Remove the flags in [arg flaglist] to the existing flags for the +message. +[list_end] + +For example: +[example { + ::imap4::store $chan $start_msgid:$end_msgid +FLAGS "Deleted" +}] + +[call [cmd ::imap4::expunge] [arg chan]] + +[para] Permanently removes all messages that have the \Deleted flag +set from the currently selected mailbox, without the need to close the +connection. + +[para][arg chan] - imap channel + +[call [cmd ::imap4::logout] [arg chan]] + +[para] Informs the server that the client is done with the connection +and closes the network connection. Permanently removes \Deleted +messages. + +[para] A new connection will need to be established to login once +more. + +[para][arg chan] - imap channel + [list_end] [section EXAMPLES] [example_begin] Index: modules/imap4/imap4.tcl ================================================================== --- modules/imap4/imap4.tcl +++ modules/imap4/imap4.tcl @@ -1,10 +1,11 @@ # IMAP4 protocol pure Tcl implementation. # # COPYRIGHT AND PERMISSION NOTICE # # Copyright (C) 2004 Salvatore Sanfilippo . +# Copyright (C) 2013 Nicola Hall # # All rights reserved. # # Permission is hereby granted, free of charge, to any person obtaining a # copy of this software and associated documentation files (the @@ -46,14 +47,14 @@ # implementation of LIST command # 20100709: Adding suppport for SSL connections, namespace variable # use_ssl must be set to 1 and package TLS must be loaded # 20100716: Bug in parsing special leading FLAGS characters in FETCH # command repaired, documentation cleanup. -# +# 20121221: Added basic scope, expunge and logout function package require Tcl 8.5 -package provide imap4 0.3 +package provide imap4 0.4 namespace eval imap4 { variable debugmode 0 ;# inside debug mode? usually not. variable folderinfo variable mboxinfo @@ -223,11 +224,11 @@ set line [string range $line [expr {$idx+1}] end] # If it's just a command continuation response, return. if {$tag eq {+}} {return +} # Extract the error code, if it's a tagged line - if {$tag ne {*}} { + if {$tag ne "*"} { set idx [string first { } $line] if {$idx <= 0} { protoerror $chan "IMAP: malformed response '$line'" } set code [string range $line 0 [expr {$idx-1}]] @@ -254,20 +255,20 @@ } set flags [string range $line [expr {$p1+1}] [expr {$p2-1}]] set delim [string range $line [expr {$p2+2}] [expr {$p3-1}]] set fname [string range $line [expr {$p3+1}] end] if {$fname eq ""} { - set folderinfo($chan,delim) [string trim $delim {"}] + set folderinfo($chan,delim) [string trim $delim "\""] } else { set fflag {} foreach f [split $flags] { lappend fflag $f } lappend folderinfo($chan,names) $fname lappend folderinfo($chan,flags) [list $fname $fflag] if {$delim ne "NIL"} { - set folderinfo($chan,delim) [string trim $delim {"}] + set folderinfo($chan,delim) [string trim $delim "\""] } } incr dirty } {FLAGS *(*)*} { @@ -523,11 +524,11 @@ # Write a request. proc request {chan request} { variable debug variable info - set t "[tag $chan] $request" + set t "[tag $chan] [string trim $request]" if {$debug} { puts "C: $t" } set info($chan,lastrequest) $t puts -nonewline $chan "$t\r\n" @@ -940,13 +941,13 @@ set rv [simplecmd $chan LIST {SELECT AUTH} \"$ref\" \"$mbox\"] if {$inline} { set rv {} foreach f [folderinfo $chan flags] { set lflags {} - foreach {fl} [lindex $f 1] { + foreach fl [lindex $f 1] { if {[string is alnum [string index $fl 0]]} { - lappend lflags [string tolower $fl]] + lappend lflags [string tolower $fl] } else { lappend lflags [string tolower [string range $fl 1 end]] } } lappend rv [list [lindex $f 0] $lflags] @@ -1216,10 +1217,67 @@ # proc ::imap4::idle notify-command # proc ::imap4::auth plain ... # proc ::imap4::securestauth user pass # proc ::imap4::store # proc ::imap4::logout (need to clean both msg and mailbox info arrays) + + # Amend the flags of a message to be updated once CLOSE/EXPUNGE is initiated + proc store {chan range key values} { + set valid_keys { + FLAGS + FLAGS.SILENT + +FLAGS + +FLAGS.SILENT + -FLAGS + -FLAGS.SILENT + } + if {$key ni $valid_keys} { + error "Invalid data item: $key. Must be one of [join $valid_keys ,]" + } + parserange $chan $range start end + set newflags {} + foreach val $values { + if {[regexp {^\\+(.*?)$} $val]} { + lappend newflags $values + } else { + lappend newflags "\\$val" + } + } + request $chan "STORE $start:$end $key ([join $newflags])" + if {[getresponse $chan]} { + return 1 + } + return 0 + } + + # Logout + proc logout {chan} { + if {[simplecmd $chan LOGOUT SELECT {}]} { + # clean out info arrays + variable info + variable folderinfo + variable mboxinfo + variable msginfo + + array unset folderinfo $chan,* + array unset mboxinfo $chan,* + array unset msginfo $chan,* + array unset info $chan,* + + return 1 + } + return 0 + } + + # Expunge : force removal of any messages with the + # flag \Deleted + proc expunge {chan} { + if {[simplecmd $chan EXPUNGE SELECT {}]} { + return 1 + } + return 0 + } } ################################################################################ # Example and test ################################################################################ Index: modules/imap4/pkgIndex.tcl ================================================================== --- modules/imap4/pkgIndex.tcl +++ modules/imap4/pkgIndex.tcl @@ -1,2 +1,2 @@ if {![package vsatisfies [package provide Tcl] 8.5]} {return} -package ifneeded imap4 0.3 [list source [file join $dir imap4.tcl]] +package ifneeded imap4 0.4 [list source [file join $dir imap4.tcl]]