Index: openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl,v
diff -u -r1.67 -r1.68
--- openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl	29 Jan 2007 17:16:50 -0000	1.67
+++ openacs-4/packages/acs-mail-lite/tcl/acs-mail-lite-procs.tcl	8 Apr 2007 08:12:51 -0000	1.68
@@ -88,38 +88,6 @@
     }
     
     #---------------------------------------
-    ad_proc -public address_domain {} {
-	@returns domain address to which bounces are directed to
-    } {
-        set domain [get_parameter -name "BounceDomain"]
-        if { $domain eq "" } {
-	    regsub {http://} [ns_config ns/server/[ns_info server]/module/nssock hostname] {} domain
-	}
-	return $domain
-    }
-    
-    #---------------------------------------
-    ad_proc -private bounce_sendmail {} {
-	@returns path to the sendmail executable
-    } {
-	return [get_parameter -name "SendmailBin"]
-    }
-    
-    #---------------------------------------
-    ad_proc -private bounce_prefix {} {
-	@returns bounce prefix for x-envelope-from
-    } {
-        return [get_parameter -name "EnvelopePrefix"]
-    }
-    
-    #---------------------------------------
-    ad_proc -private mail_dir {} {
-	@returns incoming mail directory to be scanned for bounces
-    } {
-        return [get_parameter -name "BounceMailDir"]
-    }
-    
-    #---------------------------------------
     ad_proc -public parse_email_address {
 	-email:required
     } {
@@ -134,29 +102,8 @@
         }
     }
 
-    #---------------------------------------
-    ad_proc -public bouncing_email_p {
-	-email:required
-    } {
-	Checks if email address is bouncing mail
-	@option email email address to be checked for bouncing
-	@returns boolean 1 if bouncing 0 if ok.
-    } {
-	return [db_string bouncing_p {} -default 0]
-    }
 
     #---------------------------------------
-    ad_proc -public bouncing_user_p {
-	-user_id:required
-    } {
-	Checks if email address of user is bouncing mail
-	@option user_id user to be checked for bouncing
-	@returns boolean 1 if bouncing 0 if ok.
-    } {
-	return [db_string bouncing_p {} -default 0]
-    }
-
-    #---------------------------------------
     ad_proc -private log_mail_sending {
 	-user_id:required
     } {
@@ -169,40 +116,8 @@
 	}
     }
 
-    #---------------------------------------
-    ad_proc -public bounce_address {
-        -user_id:required
-	-package_id:required
-	-message_id:required
-    } {
-	Composes a bounce address
-	@option user_id user_id of the mail recipient
-	@option package_id package_id of the mail sending package
-	        (needed to call package-specific code to deal with bounces)
-	@option message_id message-id of the mail
-	@returns bounce address
-    } {
-	return "[bounce_prefix]-$user_id-[ns_sha1 $message_id]-$package_id@[address_domain]"
-    }
     
     #---------------------------------------
-    ad_proc -public parse_bounce_address {
-        -bounce_address:required
-    } {
-        This takes a reply address, checks it for consistency,
-	and returns a list of user_id, package_id and bounce_signature found
-	@option bounce_address bounce address to be checked
-	@returns tcl-list of user_id package_id bounce_signature
-    } {
-        set regexp_str "\[[bounce_prefix]\]-(\[0-9\]+)-(\[^-\]+)-(\[0-9\]*)\@"
-        if {![regexp $regexp_str $bounce_address all user_id signature package_id]} {
-	    ns_log Debug "acs-mail-lite: bounce address not found for $bounce_address"
-            return ""
-        }
-    	return [list $user_id $package_id $signature]
-    }
-    
-    #---------------------------------------
     ad_proc -public generate_message_id {
     } {
         Generate an id suitable as a Message-Id: header for an email.
@@ -232,277 +147,6 @@
     }
 
     #---------------------------------------
-    ad_proc -private load_mails {
-        -queue_dir:required
-    } {
-        Scans for incoming email. You need
-
-        An incoming email has to comply to the following syntax rule:
-        [<SitePrefix>][-]<ReplyPrefix>-Whatever@<BounceDomain>
-
-        [] = optional
-        <> = Package Parameters
-
-        If no SitePrefix is set we assume that there is only one OpenACS installation. Otherwise
-        only messages are dealt with which contain a SitePrefix.
-
-        ReplyPrefixes are provided by packages that implement the callback acs_mail_lite::incoming_email
-        and provide a package parameter called ReplyPrefix. Only implementations are considered where the
-        implementation name is equal to the package key of the package.
-
-        Also we only deal with messages that contain a valid and registered ReplyPrefix.
-        These prefixes are automatically set in the acs_mail_lite_prefixes table.
-
-        @author Nima Mazloumi (nima.mazloumi@gmx.de)
-        @creation-date 2005-07-15
-
-        @option queue_dir The location of the qmail mail (BounceMailDir) queue in the file-system i.e. /home/service0/mail.
-
-        @see acs_mail_lite::incoming_email
-        @see acs_mail_lite::parse_email
-    } {
-       
-        # get list of all incoming mail
-        if {[catch {
-            set messages [glob "$queue_dir/new/*"]
-        } errmsg]} {
-            if {[string match "no files matched glob pattern*"  $errmsg ]} {
-                ns_log Debug "load_mails: queue dir = $queue_dir/new/*, no messages"
-            } else {
-                ns_log Error "load_mails: queue dir = $queue_dir/new/ error $errmsg"
-            }
-            return [list]
-        }
-
-        # loop over every incoming mail
-	foreach msg $messages {
-	    ns_log Debug "load_mails: opening $msg"
-	    array set email {}
-	    
-	    parse_email -file $msg -array email
- 	    set email(to) [parse_email_address -email $email(to)]
- 	    set email(from) [parse_email_address -email $email(from)]
-
-	    # We execute all callbacks now
-	    callback acs_mail_lite::incoming_email -array email
-	    
-            #let's delete the file now
-            if {[catch {ns_unlink $msg} errmsg]} {
-                ns_log Error "load_mails: unable to delete queued message $msg: $errmsg"
-            } else {
-		ns_log Debug "load_mails: deleted $msg"
-	    }
-        }
-    }
-
-    #---------------------------------------
-    ad_proc parse_email {
-	-file:required
-	-array:required
-    } {
-	An email is splitted into several parts: headers, bodies and files lists and all headers directly.
-	
-	The headers consists of a list with header names as keys and their correponding values. All keys are lower case.
-	The bodies consists of a list with two elements: content-type and content.
-	The files consists of a list with three elements: content-type, filename and content.
-	
-	The array with all the above data is upvared to the caller environment.
-
-	Important headers are:
-	
-	-message-id (a unique id for the email, is different for each email except it was bounced from a mailer deamon)
-	-subject
-	-from
-	-to
-	
-	Others possible headers:
-	
-	-date
-	-received
-        -references (this references the original message id if the email is a reply)
-	-in-reply-to (this references the original message id if the email is a reply)
-	-return-path (this is used for mailer deamons to bounce emails back like bounce-user_id-signature-package_id@service0.com)
-	
-	Optional application specific stuff only exist in special cases:
-	
-	X-Mozilla-Status
-	X-Virus-Scanned
-	X-Mozilla-Status2
-	X-UIDL
-	X-Account-Key
-	X-Sasl-enc
-	
-	You can therefore get a value for a header either through iterating the headers list or simply by calling i.e. "set message_id $email(message-id)".
-	
-	Note: We assume "application/octet-stream" for all attachments and "base64" for
-	as transfer encoding for all files.
-	
-	Note: tcllib required - mime, base64
-	
-	@author Nima Mazloumi (nima.mazloumi@gmx.de)
-	@creation-date 2005-07-15
-	
-    } {
-	upvar $array email
-
-	#prepare the message
-	if {[catch {set mime [mime::initialize -file $file]} errormsg]} {
-	    ns_log error "Email could not be delivered for file $file"
-	    set stream [open $file]
-	    set content [read $stream]
-	    close $stream
-	    ns_log error "$content"
-	    ns_unlink $file
-	    return
-	}
-	
-	#get the content type
-	set content [mime::getproperty $mime content]
-	
-	#get all available headers
-	set keys [mime::getheader $mime -names]
-		
-	set headers [list]
-
-	# create both the headers array and all headers directly for the email array
-	foreach header $keys {
-	    set value [mime::getheader $mime $header]
-	    set email([string tolower $header]) $value
-	    lappend headers [list $header $value]
-	}
-
-	set email(headers) $headers
-		
-	#check for multipart, otherwise we only have one part
-	if { [string first "multipart" $content] != -1 } {
-	    set parts [mime::getproperty $mime parts]
-	} else {
-	    set parts [list $mime]
-	}
-	
-	# travers the tree and extract parts into a flat list
-	set all_parts [list]
-	foreach part $parts {
-	    if {[mime::getproperty $part content] eq "multipart/alternative"} {
-		foreach child_part [mime::getproperty $part parts] {
-		    lappend all_parts $child_part
-		}
-	    } else {
-		lappend all_parts $part
-	    }
-	}
-	
-	set bodies [list]
-	set files [list]
-	
-	#now extract all parts (bodies/files) and fill the email array
-	foreach part $all_parts {
-
-	    # Attachments have a "Content-disposition" part
-	    # Therefore we filter out if it is an attachment here
-	    if {[catch {mime::getheader $part Content-disposition}]} {
-		switch [mime::getproperty $part content] {
-		    "text/plain" {
-			lappend bodies [list "text/plain" [mime::getbody $part]]
-		    }
-		    "text/html" {
-			lappend bodies [list "text/html" [mime::getbody $part]]
-		    }
-		}
-	    } else {
-		set encoding [mime::getproperty $part encoding]
-		set body [mime::getbody $part -decode]
-		set content  $body
-		set params [mime::getproperty $part params]
-		if {[lindex $params 0] eq "name"} {
-		    set filename [lindex $params 1]
-		} else {
-		    set filename ""
-		}
-
-		# Determine the content_type
-		set content_type [mime::getproperty $part content]
-		if {$content_type eq "application/octet-stream"} {
-		    set content_type [ns_guesstype $filename]
-		}
-
-		lappend files [list $content_type $encoding $filename $content]
-	    }
-	}
-
-	set email(bodies) $bodies
-	set email(files) $files
-	
-	#release the message
-	mime::finalize $mime -subordinates all
-    }    
-        
-    #---------------------------------------
-    ad_proc -public scan_replies {} {
-        Scheduled procedure that will scan for bounced mails
-    } {
-	# Make sure that only one thread is processing the queue at a time.
-	if {[nsv_incr acs_mail_lite check_bounce_p] > 1} {
-	    nsv_incr acs_mail_lite check_bounce_p -1
-	    return
-	}
-
-	with_finally -code {
-	    ns_log Debug "acs-mail-lite: about to load qmail queue for [mail_dir]"
-	    load_mails -queue_dir [mail_dir]
-	} -finally {
-	    nsv_incr acs_mail_lite check_bounce_p -1
-	}
-    }
-
-    #---------------------------------------
-    ad_proc -private check_bounces { } {
-	Daily proc that sends out warning mail that emails
-	are bouncing and disables emails if necessary
-    } {
-	set max_bounce_count [get_parameter -name MaxBounceCount -default 10]
-	set max_days_to_bounce [get_parameter -name MaxDaysToBounce -default 3]
-	set notification_interval [get_parameter -name NotificationInterval -default 7]
-	set max_notification_count [get_parameter -name MaxNotificationCount -default 4]
-	set notification_sender [get_parameter -name NotificationSender -default "reminder@[address_domain]"]
-
-	# delete all bounce-log-entries for users who received last email
-	# X days ago without any bouncing (parameter)
-	db_dml delete_log_if_no_recent_bounce {}
-
-	# disable mail sending for users with more than X recently
-	# bounced mails
-	db_dml disable_bouncing_email {}
-
-	# notify users of this disabled mail sending
-	db_dml send_notification_to_bouncing_email {}
-
-	# now delete bounce log for users with disabled mail sending
-	db_dml delete_bouncing_users_from_log {}
-
-	set subject "[ad_system_name] Email Reminder"
-
-	# now periodically send notifications to users with
-	# disabled email to tell them how to reenable the email
-	set notifications [db_list_of_ns_sets get_recent_bouncing_users {}]
-
-	# send notification to users with disabled email
-	foreach notification $notifications {
-	    set notification_list [util_ns_set_to_list -set $notification]
-	    array set user $notification_list
-	    set user_id $user(user_id)
-
-	    set body "Dear $user(name),\n\nDue to returning mails from your email account, we currently do not send you any email from our system. To reenable your email account, please visit\n[ad_url]/register/restore-bounce?[export_url_vars user_id]"
-
-	    send -to_addr $notification_list -from_addr $notification_sender -subject $subject -body $body -valid_email
-	    ns_log Notice "Bounce notification send to user $user_id"
-
-	    # schedule next notification
-	    db_dml log_notication_sending {}
-	}
-    }
-    
-    #---------------------------------------
     ad_proc -public deliver_mail {
 	-to_addr:required
 	-from_addr:required
@@ -954,28 +598,6 @@
     }
 
     #---------------------------------------
-    ad_proc -private after_install {} {
-	Callback to be called after package installation.
-	Adds the service contract package-specific bounce management.
-
-	@author Timo Hentschel (thentschel@sussdorff-roy.com)
-    } {
-	acs_sc::contract::new -name AcsMailLite -description "Callbacks for Bounce Management"
-	acs_sc::contract::operation::new -contract_name AcsMailLite -operation MailBounce -input "header:string body:string" -output "" -description "Callback to handle bouncing mails"
-    }
-
-    #---------------------------------------
-    ad_proc -private before_uninstall {} {
-	Callback to be called before package uninstallation.
-	Removes the service contract for package-specific bounce management.
-
-	@author Timo Hentschel (thentschel@sussdorff-roy.com)
-    } {
-	# shouldn't we first delete the bindings?
-	acs_sc::contract::delete -name AcsMailLite
-    }
-
-    #---------------------------------------
     ad_proc -private message_interpolate {
 	{-values:required}
 	{-text:required}