Tcl Library Source Code

2013-01-25  Andreas Kupries  <[email protected]>

	* imap4.man: Updated documentation with text contributed by Nicola
	  Hall, explaining the new commands.

2013-01-22  Andreas Kupries  <[email protected]>

	* imap4.tcl: Applied contribution by Nicola Hall.
	* imap4.man: Additional commands. Bumped version
	* pkgIndex.tcl: to 0.4.

2011-12-13  Andreas Kupries  <[email protected]>

	*
	* Released and tagged Tcllib 1.14 ========================
	* 

2011-01-24  Andreas Kupries  <[email protected]>

[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.4]]

[description]

The [package imap4] library package provides the client side of the
[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.

[section "PROCEDURES"]

returned instead of the result code. All flags are converted to
lowercase and leading special characters are removed.
[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 [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 [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
which can be retrieved with command [cmd ::imap4::msginfo], 0 is returned
on success.

[para]If the required information name is suffixed with a ? character,
the command returns true if the information is available, or
false if it is not.
[para][arg chan] - imap channel
[para][arg info] - folderlist options to retrieve
[para]
Currently supported options:
[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}}}
}]
[call [cmd ::imap4::msginfo] [arg chan] [arg msgid] [opt [arg info]] [opt [arg defval]]]
[para]Get information (from previously collected using fetch) from a given

[para]If the required information name is suffixed with a ? character,
the command returns true if the information is available, or
false if it is not.
[para][arg chan] - imap channel
[para][arg opt] - mailbox option to retrieve
[para]
Currently supported options:
[emph EXISTS] (noof msgs), 
[emph RECENT] (noof 'recent' flagged msgs), 
[emph FLAGS]
[para]In conjunction with OK:
[emph PERMFLAGS], [emph UIDNEXT], [emph UIDVAL], [emph UNSEEN]
[para]Div. states:
[emph CURRENT], [emph FOUND], [emph PERM].

[example {
    ::imap4::select $chan INBOX
    puts "[::imap4::mboxinfo $chan exists] mails in INBOX"}]

[call [cmd ::imap4::isableto] [arg chan] [opt [arg capability]]]
[para]Test for capability.

programmer. Every line entered is sent verbatim to the
server (after the addition of the request identifier).
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]
    set user myusername
    set pass xtremescrt

# IMAP4 protocol pure Tcl implementation.
#
# COPYRIGHT AND PERMISSION NOTICE
#
# Copyright (C) 2004 Salvatore Sanfilippo <[email protected]>.
# Copyright (C) 2013 Nicola Hall <[email protected]>
#
# All rights reserved.
#
# Permission is hereby granted, free of charge, to any person obtaining a
# copy of this software and associated documentation files (the
# "Software"), to deal in the Software without restriction, including
# without limitation the rights to use, copy, modify, merge, publish,

#             option -inline for ::imap4::fetch, in order to return data as a Tcl list
#             isableto without arguments returns the capability list
#             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.4

namespace eval imap4 {
    variable debugmode 0     ;# inside debug mode? usually not.
    variable folderinfo
    variable mboxinfo
    variable msginfo
    variable info

        set tag [string range $line 0 [expr {$idx-1}]]
        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 "*"} {
            set idx [string first { } $line]
            if {$idx <= 0} {
                protoerror $chan "IMAP: malformed response '$line'"
            }
            set code [string range $line 0 [expr {$idx-1}]]
            set line [string trim [string range $line [expr {$idx+1}] end]]
            set info($chan,lastcode) $code

                if {$p1<0||$p2<0||$p3<0} {
                    protoerror $chan "IMAP: Not a valid RFC822 LIST format in '$line'"
                }
                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 "\""]
                } 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 "\""]
                    }
                }
                incr dirty
            }
            {FLAGS *(*)*} {
                regexp {.*\((.*)\).*} $line => flags
                set mboxinfo($chan,flags) $flags

    }

    # Write a request.
    proc request {chan request} {
        variable debug
        variable info

        set t "[tag $chan] [string trim $request]"
        if {$debug} {
            puts "C: $t"
        }
        set info($chan,lastrequest) $t
        puts -nonewline $chan "$t\r\n"
        flush $chan
    }

        set folderinfo($chan,match) [list $ref $mbox]
        # parray folderinfo
        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] {
                    if {[string is alnum [string index $fl 0]]} {
                        lappend lflags [string tolower $fl]
                    } else {
                        lappend lflags [string tolower [string range $fl 1 end]]
                    }
                }
                lappend rv [list [lindex $f 0] $lflags]
            }
        }

    # Other stuff to do in random order...
    #
    # 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
################################################################################
if {[info script] eq $argv0} {
    # set imap4::debug 0

if {![package vsatisfies [package provide Tcl] 8.5]} {return}
package ifneeded imap4 0.4 [list source [file join $dir imap4.tcl]]