Skip to content

A
acs-mail-lite
Commit d7e69903 authored by Malte Sussdorff's avatar Malte Sussdorff
Browse files
Options

- Malte

parent cd19d3fa
Pipeline #83 failed with stages
      Hide whitespace changes
      Inline Side-by-side
      Showing with 2781 additions and 583 deletions
      acs-mail-lite.info
      View file @ d7e69903
      ......@@ -7,32 +7,41 @@
      <initial-install-p>f</initial-install-p>
      <singleton-p>t</singleton-p>
      <version name="0.7a" url="http://openacs.org/repository/download/apm/acs-mail-lite-0.7a.apm">
      <version name="5.4.0d2" url="http://openacs.org/repository/download/apm/acs-mail-lite-5.4.0d2.apm">
      <owner url="mailto:eric@openforce.biz">Eric Lorenzo</owner>
      <owner url="mailto:timo@studio-k4.de">Timo Hentschel</owner>
      <summary>Simplified reliable email transmission with bounce management.</summary>
      <release-date>2004-01-14</release-date>
      <release-date>2005-10-19</release-date>
      <description format="text/html">This package provides a simple ns_sendmail-like interface for sending messages, but queues messages in the database to ensure reliable sending and make sending a message 'transactional'. Prefered over acs-messaging or acs-mail.</description>
      <maturity>2</maturity>
      <provides url="acs-mail-lite" version="0.7a"/>
      <provides url="acs-mail-lite" version="5.4.0d2"/>
      <requires url="acs-tcl" version="5.3.0d2"/>
      <callbacks>
      <callback type="before-uninstall" proc="acs_mail_lite::before_uninstall"/>
      <callback type="after-install" proc="acs_mail_lite::after_install"/>
      </callbacks>
      <parameters>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="BounceDomain" description="Email Domain for outgoing messages" section_name="email"/>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="BounceMailDir" description="Location of the maildir location that accepts incoming bounces" section_name="email"/>
      <parameter datatype="number" min_n_values="1" max_n_values="1" name="BounceScanQueue" default="120" description="How often (in seconds) to scan for new bounces" section_name="email"/>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="EnvelopePrefix" default="bounce" description="The prefix for sending mail that will be handled by this instance" section_name="email"/>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="FixedSenderEmail" description="Email addres that will be always the email stored in the sender. Default is empty" section_name="email"/>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="FixedFont" description="Font definition (after the font tag) that will always be wrapped around HTML e-mail. Example: face=Verdana size=2. Default is empty" section_name="email"/>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="MMEncodeBin" default="/usr/bin/mmencode" description="Location of mmencode executable." section_name="email"/>
      <parameter datatype="number" min_n_values="1" max_n_values="1" name="MaxBounceCount" default="10" description="Number of bounced emails after resulting in disabling an email-address" section_name="email"/>
      <parameter datatype="number" min_n_values="1" max_n_values="1" name="MaxDaysToBounce" default="2" description="Number of days after mail sending a bounce is expected at the very latest" section_name="email"/>
      <parameter datatype="number" min_n_values="1" max_n_values="1" name="MaxNotificationCount" default="4" description="Number of times the user will get a notification that his email got disabled in the system" section_name="email"/>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="MMEncodeBin" default="/usr/bin/mmencode" description="Location of mmencode executable." section_name="email"/>
      <parameter datatype="number" min_n_values="1" max_n_values="1" name="NotificationInterval" default="7" description="Number of days the users with bouncing email will be notified again on how to reenable the email again" section_name="email"/>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="NotificationSender" default="reminder@openacs.org" description="Sender of the notification email" section_name="email"/>
      <parameter datatype="number" min_n_values="1" max_n_values="1" name="send_immediately" default="0" description="Boolean value to say whether new mails should be send out immediately or stored in the db before send out." section_name="email"/>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="NotificationSender" description="Sender of the notification email" section_name="email"/>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="SendmailBin" default="/usr/sbin/sendmail" description="Location of sendmail binary on your system (Set to SMTP to use SMTP server)" section_name="email"/>
      <parameter datatype="number" min_n_values="1" max_n_values="1" name="send_immediately" default="0" description="Boolean value to say whether new mails should be send out immediately or stored in the db before send out." section_name="email"/>
      <parameter datatype="number" min_n_values="1" max_n_values="1" name="FolderID" default="" description="Folder ID of a folder in the content repository that contains files that can be included using checkboxes in each e-mail send out of the system. This effects /lib/email" section_name="email"/>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="SMTPHost" default="localhost" description="SMTP Host to be used for sending emails" section_name="SMTP"/>
      <parameter datatype="number" min_n_values="1" max_n_values="1" name="SMTPPort" default="25" description="SMTP Port to be used for sending emails" section_name="SMTP"/>
      <parameter datatype="number" min_n_values="1" max_n_values="1" name="SMTPTimeout" default="60" description="SMTP Timeout. Waiting time until we give up with the mailserver." section_name="SMTP"/>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="SMTPUser" default="" description="SMTP User to be used for sending emails" section_name="SMTP"/>
      <parameter datatype="string" min_n_values="1" max_n_values="1" name="SMTPPassword" default="" description="SMTP Password to be used for sending emails" section_name="SMTP"/>
      </parameters>
      </version>
      ......
      catalog/acs-mail-lite.ca_ES.ISO-8859-1.xml 0 → 100644
      View file @ d7e69903
      <?xml version="1.0" encoding="ISO-8859-1"?>
      <message_catalog package_key="acs-mail-lite" package_version="1.1" locale="ca_ES" charset="ISO-8859-1">
      <msg key="Associated_files">Fitxers associats:</msg>
      <msg key="CC">CC</msg>
      <msg key="cc_help">Envia'n cpia a diverses adreces separades per &amp;quot;;&amp;quot;</msg>
      <msg key="check_uncheck">Selecciona/Deselecciona</msg>
      <msg key="lt_there_was_an_error_processing">S'ha produt un error en processar aquesta petici.</msg>
      <msg key="Message">Missatge</msg>
      <msg key="Recipients">Destinataris</msg>
      <msg key="Send">Envia</msg>
      <msg key="Subject">Assumpte</msg>
      <msg key="Untitled">Sense ttol</msg>
      <msg key="Upload_file">Carrega arxiu</msg>
      <msg key="Your_message_was_sent_to">El missatge s'ha enviat a: &amp;amp;lt;strong&amp;amp;gt;%recipients%&amp;amp;lt;/strong&amp;amp;gt;</msg>
      </message_catalog>
      catalog/acs-mail-lite.de_DE.ISO-8859-1.xml 0 → 100644
      View file @ d7e69903
      <?xml version="1.0" encoding="ISO-8859-1"?>
      <message_catalog package_key="acs-mail-lite" package_version="1.3b5" locale="de_DE" charset="ISO-8859-1">
      <msg key="Associated_files">Verknpfte Dateien:</msg>
      <msg key="CC">CC</msg>
      <msg key="cc_help">Liste von E-Mail Adressen durch &quot;;&quot; getrennt an die eine Kopie der E-Mail geschickt werden soll.</msg>
      <msg key="check_uncheck">Alle/Keine auswhlen</msg>
      <msg key="lt_there_was_an_error_processing">Es gab einen Fehler bei der Verarbeitung Ihrer Anfrage</msg>
      <msg key="Message">Nachricht</msg>
      <msg key="Queue_server">Serverproze</msg>
      <msg key="Queueing_time">Queue-Zeitpunkt</msg>
      <msg key="Recipients">Empfnger</msg>
      <msg key="Send">Senden</msg>
      <msg key="Sender">Absender</msg>
      <msg key="Subject">Betreff</msg>
      <msg key="Untitled">Unbenannt</msg>
      <msg key="Upload_file">Datei hinzufgen</msg>
      <msg key="Your_message_was_sent_to">Ihre Nachricht wurde an die folgende Empfnger geschickt: %recipients%</msg>
      </message_catalog>
      catalog/acs-mail-lite.en_US.ISO-8859-1.xml 0 → 100644
      View file @ d7e69903
      <?xml version="1.0" encoding="ISO-8859-1"?>
      <message_catalog package_key="acs-mail-lite" package_version="5.4.0d1" locale="en_US" charset="ISO-8859-1">
      <msg key="Associated_files">Associated Files:</msg>
      <msg key="BCC">BCC</msg>
      <msg key="Bounce_disabled">Bouncing recorded as disabled. You will receive E-Mails again.</msg>
      <msg key="Bouncing_users">Bouncing users</msg>
      <msg key="CC">CC</msg>
      <msg key="cc_help">Send copy to multiple addresses separated by &quot;;&quot;</msg>
      <msg key="check_uncheck">Check/Uncheck</msg>
      <msg key="lt_there_was_an_error_processing">There was an error processing this request.</msg>
      <msg key="Message">Message</msg>
      <msg key="Queue_server">Queue server</msg>
      <msg key="Queueing_time">Queueing time</msg>
      <msg key="Recipients">Recipients</msg>
      <msg key="Send">Send</msg>
      <msg key="Sender">Sender</msg>
      <msg key="Subject">Subject</msg>
      <msg key="Unbounce">Unbounce</msg>
      <msg key="Untitled">Untitled</msg>
      <msg key="Upload_file">Upload File</msg>
      <msg key="Your_message_was_sent_to">Your message was sent to: &amp;lt;strong&amp;gt;%recipients%&amp;lt;/strong&amp;gt;</msg>
      </message_catalog>
      catalog/acs-mail-lite.es_ES.ISO-8859-1.xml 0 → 100644
      View file @ d7e69903
      <?xml version="1.0" encoding="ISO-8859-1"?>
      <message_catalog package_key="acs-mail-lite" package_version="5.3.0" locale="es_ES" charset="ISO-8859-1">
      <msg key="Associated_files">Archivos asociados:</msg>
      <msg key="CC">CC</msg>
      <msg key="cc_help">Enviar copia a varias direcciones separadas por &quot;;&quot;</msg>
      <msg key="check_uncheck">Seleccionar/deseleccionar</msg>
      <msg key="lt_there_was_an_error_processing">Ocurri un error al procesar su peticin.</msg>
      <msg key="Message">Mensaje</msg>
      <msg key="Recipients">Destinatarios</msg>
      <msg key="Send">Enviar</msg>
      <msg key="Subject">Asunto</msg>
      <msg key="Untitled">Sin ttulo</msg>
      <msg key="Upload_file">Subir Archivo</msg>
      <msg key="Your_message_was_sent_to">Su mensaje ha sido enviado a: &lt;strong&gt;%recipients%&lt;/strong&gt;</msg>
      </message_catalog>
      catalog/acs-mail-lite.gl_ES.ISO-8859-1.xml 0 → 100644
      View file @ d7e69903
      <?xml version="1.0" encoding="ISO-8859-1"?>
      <message_catalog package_key="acs-mail-lite" package_version="1.1" locale="gl_ES" charset="ISO-8859-1">
      <msg key="Associated_files">Arquivos asociados:</msg>
      <msg key="CC">CC</msg>
      <msg key="cc_help">Enviar copia a varias direccins separadas por &amp;quot;;&amp;quot;</msg>
      <msg key="check_uncheck">Seleccionar/deseleccionar</msg>
      <msg key="lt_there_was_an_error_processing">Ocorreu un erro procesar a sa peticin</msg>
      <msg key="Message">Mensaxe</msg>
      <msg key="Recipients">Destinatarios</msg>
      <msg key="Send">Enviar</msg>
      <msg key="Subject">Asunto</msg>
      <msg key="Untitled">Sin ttulo</msg>
      <msg key="Upload_file">Subir Arquivo</msg>
      <msg key="Your_message_was_sent_to">A sa mensaxe foi enviada a:
      &lt;strong&gt;%recipients%&lt;/strong&gt;</msg>
      </message_catalog>
      catalog/acs-mail-lite.nl_NL.ISO-8859-1.xml 0 → 100644
      View file @ d7e69903
      <?xml version="1.0" encoding="ISO-8859-1"?>
      <message_catalog package_key="acs-mail-lite" package_version="1.1" locale="nl_NL" charset="ISO-8859-1">
      <msg key="Associated_files">Verbintenis met de bestanden:</msg>
      <msg key="CC">CC</msg>
      <msg key="cc_help">Stuur kopie aan meerdere adressen gescheiden door &quot;;&quot;</msg>
      <msg key="check_uncheck">Aanvinken/Afvinken</msg>
      <msg key="lt_there_was_an_error_processing">Er is een fout opgetreden tijdens het verwerken van dit verzoek.</msg>
      <msg key="Message">Bericht</msg>
      <msg key="Recipients">Ontvangers</msg>
      <msg key="Send">Verstuur</msg>
      <msg key="Subject">Onderwerp</msg>
      <msg key="Untitled">Naamloos</msg>
      <msg key="Upload_file">Bestand opladen</msg>
      <msg key="Your_message_was_sent_to">Uw bericht is verstuurd aan &lt;strong&gt;%recipients%&lt;/strong&gt;</msg>
      </message_catalog>
      catalog/acs-mail-lite.nl_ZA.ISO-8859-1.xml 0 → 100644
      View file @ d7e69903
      <?xml version="1.0" encoding="ISO-8859-1"?>
      <message_catalog package_key="acs-mail-lite" package_version="1.1" locale="nl_ZA" charset="ISO-8859-1">
      <msg key="Associated_files">Verbintenis met die lers:</msg>
      <msg key="CC">CC</msg>
      <msg key="cc_help">Stuur kopie aan meerdere adresse geskeide deur &quot;;&quot;</msg>
      <msg key="check_uncheck">Vink aan/Vink af</msg>
      <msg key="lt_there_was_an_error_processing">Daar het 'n fout opgetree tydens verwerking van hierdie versoek.</msg>
      <msg key="Message">Berig</msg>
      <msg key="Recipients">Ontvangers</msg>
      <msg key="Send">Verstuur</msg>
      <msg key="Subject">Onderwerp</msg>
      <msg key="Untitled">Naamloos</msg>
      <msg key="Upload_file">Laai ler</msg>
      <msg key="Your_message_was_sent_to">U berig is verstuur aan &lt;string&gt;%recipients%&lt;/strong&gt;</msg>
      </message_catalog>
      catalog/acs-mail-lite.pl_PL.utf-8.xml 0 → 100644
      View file @ d7e69903
      <?xml version="1.0" encoding="utf-8"?>
      <message_catalog package_key="acs-mail-lite" package_version="1.1" locale="pl_PL" charset="utf-8">
      <msg key="Associated_files">Powiązane Pliki:</msg>
      <msg key="CC">CC</msg>
      <msg key="cc_help">Wyślij kopie pod wiele adresów rozdzielając je &quot;;&quot;</msg>
      <msg key="check_uncheck">Zaznacz/Odznacz</msg>
      <msg key="lt_there_was_an_error_processing">Wystąpił błąd.</msg>
      <msg key="Message">Komunikat</msg>
      <msg key="Recipients">Adresaci</msg>
      <msg key="Send">Wyślij</msg>
      <msg key="Subject">Temat</msg>
      <msg key="Untitled">Bez Tytułu</msg>
      <msg key="Upload_file">Wgraj Plik</msg>
      <msg key="Your_message_was_sent_to">Twój komunikat wysłano do: &amp;lt;strong&amp;gt;%recipients%&amp;lt;/strong&amp;gt;</msg>
      </message_catalog>
      catalog/acs-mail-lite.pt_BR.ISO-8859-1.xml 0 → 100644
      View file @ d7e69903
      <?xml version="1.0" encoding="ISO-8859-1"?>
      <message_catalog package_key="acs-mail-lite" package_version="1.1" locale="pt_BR" charset="ISO-8859-1">
      <msg key="Associated_files">Arquivos Associados:</msg>
      <msg key="CC">CC</msg>
      <msg key="cc_help">Enviar cpia para mltiplos endereos de email separados por &quot;;&quot;</msg>
      <msg key="check_uncheck">Marcar/Desmarcar</msg>
      <msg key="lt_there_was_an_error_processing">Ocorreu um erro ao processar esta solicitao.</msg>
      <msg key="Message">Mensagem</msg>
      <msg key="Recipients">Destinatrios</msg>
      <msg key="Send">Enviar</msg>
      <msg key="Subject">Assunto</msg>
      <msg key="Untitled">Sem ttulo</msg>
      <msg key="Upload_file">Anexar Arquivo</msg>
      <msg key="Your_message_was_sent_to">Sua mensagem foi enviada para: &amp;lt;strong&amp;gt;%recipients%&amp;lt;/strong&amp;gt;</msg>
      </message_catalog>
      lib/email.adp 0 → 100644
      View file @ d7e69903
      <SCRIPT LANGUAGE = "JavaScript">
      <!--
      function check_uncheck_boxes(checkP){
      for ( i=0 ; i < document.email.to.length; i++) {
      document.email.to[i].checked = checkP;
      }
      }
      -->
      </SCRIPT>
      <formtemplate id="email"></formtemplate>
      lib/email.tcl 0 → 100644
      View file @ d7e69903
      # packages/acs-mail-lite/lib/email.tcl
      # Template for email inclusion
      # @author Malte Sussdorff (sussdorff@sussdorff.de)
      # @creation-date 2005-06-14
      # @arch-tag: 48fe00a8-a527-4848-b5de-0f76dfb60291
      # @cvs-id $Id$
      foreach optional_param {party_ids return_url content export_vars file_ids object_id cc item_id bcc to_addr to} {
      if {![info exists $optional_param]} {
      set $optional_param {}
      }
      }
      # See if the contacts and mail-tracking packages are installed.
      set contacts_p [apm_package_installed_p "contacts"]
      set tracking_p [apm_package_installed_p "mail-tracking"]
      if {![info exists mime_type]} {
      set mime_type "text/plain"
      }
      if {![exists_and_not_null cancel_url]} {
      set cancel_url $return_url
      }
      if {![info exists no_callback_p]} {
      set no_callback_p f
      }
      if {![info exists use_sender_p]} {
      set use_sender_p f
      }
      if {![info exists checked_p]} {
      set checked_p t
      }
      # Somehow when the form is submited the party_ids values became
      # only one element of a list, this avoid that problem
      set recipients [list]
      foreach party_id $party_ids {
      if {$party_id ne ""} {
      if { $contacts_p } {
      lappend recipients [list "<a href=\"[contact::url -party_id $party_id]\">[contact::name -party_id $party_id]</a> ([cc_email_from_party $party_id])" $party_id]
      } else {
      lappend recipients [list "[acs_mail_lite::party_name -party_id $party_id]</a> ([cc_email_from_party $party_id])" $party_id]
      }
      }
      }
      # The element check_uncheck only calls a javascript function
      # to check or uncheck all recipients
      set recipients_num [llength $recipients]
      if { $recipients_num <= 1 } {
      set form_elements {
      message_id:key
      return_url:text(hidden)
      cancel_url:text(hidden)
      no_callback_p:text(hidden)
      use_sender_p:text(hidden)
      title:text(hidden),optional
      {message_type:text(hidden) {value "email"}}
      }
      if {$recipients_num == 1} {
      append form_elements {
      {to:text(checkbox),multiple,optional
      {label "[_ acs-mail-lite.Recipients]"}
      {options $recipients }
      {html {checked 1}}
      {section "[_ acs-mail-lite.Recipients]"}
      }
      }
      } else {
      append form_elements {
      {to_addr:text(text),optional
      {label "[_ acs-mail-lite.Recipients]:"}
      {html {size 56}}
      {help_text "[_ acs-mail-lite.cc_help]"}
      }
      }
      }
      append form_elements {
      {cc:text(text),optional
      {label "[_ acs-mail-lite.CC]:"}
      {html {size 56}}
      {help_text "[_ acs-mail-lite.cc_help]"}
      }
      {bcc:text(text),optional
      {label "[_ acs-mail-lite.BCC]:"}
      {html {size 56}}
      {help_text "[_ contacts.cc_help]"}
      }
      }
      } else {
      set form_elements {
      message_id:key
      return_url:text(hidden)
      cancel_url:text(hidden)
      no_callback_p:text(hidden)
      title:text(hidden),optional
      {message_type:text(hidden) {value "email"}}
      {check_uncheck:text(checkbox),multiple,optional
      {label "[_ acs-mail-lite.check_uncheck]"}
      {options {{"" 1}}}
      {section "[_ acs-mail-lite.Recipients]"}
      {html {onclick check_uncheck_boxes(this.checked)}}
      }
      }
      if {$checked_p eq "t"} {
      append form_elements {
      {to:text(checkbox),multiple,optional
      {label "[_ acs-mail-lite.Recipients]"}
      {options $recipients }
      {html {checked 1}}
      }
      }
      } else {
      append form_elements {
      {to:text(checkbox),multiple,optional
      {label "[_ acs-mail-lite.Recipients]"}
      {options $recipients }
      }
      }
      }
      }
      if { [exists_and_not_null file_ids] } {
      set files [list]
      foreach file $file_ids {
      set file_title [lang::util::localize [content::item::get_title -item_id $file]]
      if {$file_title eq ""} {
      set file_title "empty"
      }
      if { $tracking_p } {
      lappend files "<a href=\"/tracking/download/$file_title?file_id=$file\">$file_title</a> "
      } else {
      lappend files "$file_title "
      }
      }
      set files [join $files ", "]
      append form_elements {
      {file_ids:text(hidden) {value $file_ids}}
      {files:text(inform),optional {label "[_ acs-mail-lite.Associated_files]"} {value $files}}
      }
      }
      # Get the list of files from the file storage folder
      set file_folder_id [parameter::get_from_package_key -package_key "acs-mail-lite" -parameter "FolderID"]
      if {$file_folder_id ne ""} {
      # get the list of files in an option
      set file_options [db_list_of_lists files {
      select r.title, i.item_id
      from cr_items i, cr_revisions r
      where i.parent_id = :file_folder_id
      and i.content_type = 'file_storage_object'
      and r.revision_id = i.latest_revision
      }]
      if {$file_options ne ""} {
      append form_elements {
      {files_extend:text(checkbox),optional
      {label "[_ acs-mail-lite.Additional_files]"}
      {options $file_options}
      }
      }
      }
      }
      foreach var $export_vars {
      upvar $var var_value
      # We need to split to construct the element with two lappends
      # becasue if we put something like this {value $value} the value
      # of the variable is not interpreted
      set element [list]
      lappend element "${var}:text(hidden)"
      lappend element "value $var_value"
      # Adding the element to the form
      lappend form_elements $element
      }
      set content_list [list $content $mime_type]
      append form_elements {
      {subject:text(text),optional
      {label "[_ acs-mail-lite.Subject]"}
      {html {size 55}}
      {section "[_ acs-mail-lite.Message]"}
      }
      {content_body:text(richtext),optional
      {label "[_ acs-mail-lite.Message]"}
      {html {cols 55 rows 18}}
      {value $content_list}
      }
      {upload_file:file(file),optional
      {label "[_ acs-mail-lite.Upload_file]"}
      }
      }
      if { [exists_and_not_null item_id] } {
      append form_elements {
      {item_id:text(hidden),optional
      {value $item_id}
      }
      }
      }
      if { ![exists_and_not_null action] } {
      set action [ad_conn url]
      }
      set edit_buttons [list [list [_ acs-mail-lite.Send] send]]
      ad_form -action $action \
      -html {enctype multipart/form-data} \
      -name email \
      -cancel_label "[_ acs-kernel.common_Cancel]" \
      -cancel_url $cancel_url \
      -edit_buttons $edit_buttons \
      -form $form_elements \
      -on_request {
      } -new_request {
      if { $contacts_p } {
      if {[exists_and_not_null folder_id] } {
      callback contacts::email_subject -folder_id $folder_id
      }
      if {[exists_and_not_null item_id] } {
      contact::message::get -item_id $item_id -array message_info
      set subject $message_info(description)
      set content_body [list $message_info(content) $message_info(content_format)]
      set title $message_info(title)
      }
      if {[exists_and_not_null signature_id] } {
      set signature [contact::signature::get -signature_id $signature_id]
      if { [exists_and_not_null signature] } {
      append content_body "{<br><br> $signature } text/html"
      }
      }
      }
      } -edit_request {
      } -on_submit {
      # List to store know wich emails recieved the message
      set recipients_addr [list]
      set from [ad_conn user_id]
      set from_addr [cc_email_from_party $from]
      # Remove all spaces in cc and bcc
      regsub -all " " $to_addr "" to_addr
      regsub -all " " $cc "" cc
      regsub -all " " $bcc "" bcc
      set to_list [split $to_addr ";"]
      set cc_list [split $cc ";"]
      set bcc_list [split $bcc ";"]
      # Insert the uploaded file linked under the package_id
      set package_id [ad_conn package_id]
      if {$upload_file ne "" } {
      set revision_id [content::item::upload_file \
      -package_id $package_id \
      -upload_file $upload_file \
      -parent_id $party_id]
      }
      if {[exists_and_not_null revision_id]} {
      if {[exists_and_not_null file_ids]} {
      append file_ids " $revision_id"
      } else {
      set file_ids $revision_id
      }
      }
      # Append the additional files
      if {[exists_and_not_null files_extend]} {
      foreach file_id $files_extend {
      lappend file_ids $file_id
      }
      }
      # Send the mail to all parties.
      foreach party_id $to {
      set name [party::name -party_id $party_id]
      set first_names [lindex $name 0]
      set last_name [lindex $name 1]
      set date [lc_time_fmt [dt_sysdate] "%q"]
      set to $name
      set to_addr [party::email -party_id $party_id]
      # This should not be happening in the first place and should be removed from here later....
      if {$to_addr eq ""} {
      # We are going to check if this party_id has an employer and if this
      # employer has an email
      set employer_id [relation::get_object_two -object_id_one $party_id \
      -rel_type "contact_rels_employment"]
      if { $employer_id ne "" } {
      # Get the employer email adress
      set to_addr [party::email -party_id $employer_id]
      if {$to_addr eq ""} {
      ad_return_error [_ acs-kernel.common_Error] [_ acs-mail-lite.lt_there_was_an_error_processing]
      break
      }
      } else {
      ad_return_error [_ acs-mail-lite.Error] [_ acs-mail-lite.lt_there_was_an_error_processing]
      break
      }
      }
      set values [list]
      foreach element [list first_names last_name name date] {
      lappend values [list "{$element}" [set $element]]
      }
      set subject [contact::message::interpolate -text $subject -values $values]
      set content_body [contact::message::interpolate -text $content_body -values $values]
      acs_mail_lite::complex_send \
      -to_party_ids $party_id \
      -to_addr $to_list \
      -cc_addr $cc_list \
      -bcc_addr $bcc_list \
      -from_addr "$from_addr" \
      -subject "$subject" \
      -body "$content_body" \
      -package_id $package_id \
      -file_ids $file_ids \
      -mime_type $mime_type \
      -object_id $object_id \
      -no_callback_p $no_callback_p \
      -single_email
      # Link the file to all parties
      if {[exists_and_not_null revision_id]} {
      application_data_link::new -this_object_id $revision_id -target_object_id $party_id
      }
      lappend recipients "$to"
      }
      if {$to eq ""} {
      acs_mail_lite::complex_send \
      -to_addr $to_list \
      -cc_addr $cc_list \
      -bcc_addr $bcc_list \
      -from_addr "$from_addr" \
      -subject "$subject" \
      -body "$content_body" \
      -package_id $package_id \
      -file_ids $file_ids \
      -mime_type $mime_type \
      -object_id $object_id \
      -no_callback_p $no_callback_p \
      -single_email
      }
      util_user_message -html -message "[_ acs-mail-lite.Your_message_was_sent_to]"
      } -after_submit {
      ad_returnredirect $return_url
      }
      lib/email.xql 0 → 100644
      View file @ d7e69903
      <?xml version="1.0"?>
      <queryset>
      <fullquery name="get_file_title">
      <querytext>
      select
      title
      from
      cr_revisions
      where
      revision_id = :file
      </querytext>
      </fullquery>
      </queryset>
      \ No newline at end of file
      lib/view-complex-send-mail-queue.adp 0 → 100644
      View file @ d7e69903
      <listtemplate name="get_all_complex_queued_messages"></listtemplate>
      lib/view-complex-send-mail-queue.tcl 0 → 100644
      View file @ d7e69903
      # 2006/11/17 created (nfl)
      template::list::create \
      -name get_all_complex_queued_messages \
      -selected_format normal \
      -multirow messages \
      -elements {
      creation_date { label "[_ acs-mail-lite.Queueing_time]" }
      from_addr { label "[_ acs-mail-lite.Sender]" }
      to_addr { label "[_ acs-mail-lite.Recipients]" }
      subject { label "[_ acs-mail-lite.Subject]" }
      locking_server { label "[_ acs-mail-lite.Queue_server]" }
      }
      db_multirow messages get_all_complex_queued_messages {}
      lib/view-complex-send-mail-queue.xql 0 → 100644
      View file @ d7e69903
      <?xml version="1.0"?>
      <queryset>
      <fullquery name="get_all_complex_queued_messages">
      <querytext>
      select
      id,
      creation_date,
      locking_server,
      to_party_ids,
      cc_party_ids,
      bcc_party_ids,
      to_group_ids,
      cc_group_ids,
      bcc_group_ids,
      to_addr,
      cc_addr,
      bcc_addr,
      from_addr,
      subject,
      body,
      package_id,
      files,
      file_ids,
      folder_ids,
      mime_type,
      object_id,
      (case when single_email_p = TRUE then 1 else 0 end) as single_email_p,
      (case when no_callback_p = TRUE then 1 else 0 end) as no_callback_p,
      extraheaders,
      (case when alternative_part_p = TRUE then 1 else 0 end) as alternative_part_p,
      (case when use_sender_p = TRUE then 1 else 0 end) as use_sender_p
      from acs_mail_lite_complex_queue
      order by creation_date
      </querytext>
      </fullquery>
      </queryset>
      sql/oracle/acs-mail-lite-create.sql
      View file @ d7e69903
      ......@@ -26,9 +26,9 @@ create table acs_mail_lite_queue (
      );
      create table acs_mail_lite_mail_log (
      user_id integer
      party_id integer
      constraint acs_mail_lite_log_user_id_fk
      references users (user_id)
      references parties (party_id)
      on delete cascade
      constraint acs_mail_lite_log_pk
      primary key,
      ......@@ -37,9 +37,9 @@ create table acs_mail_lite_mail_log (
      create table acs_mail_lite_bounce (
      user_id integer
      party_id integer
      constraint acs_mail_lite_bou_user_id_fk
      references users (user_id)
      references parties (party_id)
      on delete cascade
      constraint acs_mail_lite_bou_pk
      primary key,
      ......@@ -48,12 +48,53 @@ create table acs_mail_lite_bounce (
      create table acs_mail_lite_bounce_notif (
      user_id integer
      party_id integer
      constraint acs_mail_li_bou_notif_us_id_fk
      references users (user_id)
      references parties (party_id)
      on delete cascade
      constraint acs_mail_lite_notif_pk
      primary key,
      notification_time date default sysdate,
      notification_count integer default 0
      );
      CREATE TABLE acs_mail_lite_complex_queue (
      id integer
      constraint acs_mail_lite_complex_queue_pk
      PRIMARY KEY,
      creation_date text,
      locking_server text,
      to_party_ids varchar(4000),
      cc_party_ids varchar(4000),
      bcc_party_ids varchar(4000),
      to_group_ids varchar(4000),
      cc_group_ids varchar(4000),
      bcc_group_ids varchar(4000),
      to_addr clob,
      cc_addr clob,
      bcc_addr clob,
      from_addr varchar(400),
      reply_to varchar(400),
      subject varchar(4000),
      body clob,
      package_id integer,
      files varchar(4000),
      file_ids varchar(4000),
      folder_ids varchar(4000),
      mime_type varchar(200),
      object_id integer,
      single_email_p varchar2(1)
      constraint acs_mail_lite_co_qu_single_em_p_ck
      check (valid_email_p in ('t','f')),
      no_callback_p varchar2(1)
      constraint acs_mail_lite_co_qu_no_callb_p_ck
      check (valid_email_p in ('t','f')),
      extraheaders clob,
      alternative_part_p varchar2(1)
      constraint acs_mail_lite_co_qu_alt_part_p_ck
      check (valid_email_p in ('t','f')),
      use_sender_p varchar2(1)
      constraint acs_mail_lite_co_qu_use_sender_p_ck
      check (valid_email_p in ('t','f'))
      );
      sql/oracle/acs-mail-lite-drop.sql
      View file @ d7e69903
      ......@@ -7,3 +7,7 @@
      drop table acs_mail_lite_queue;
      drop sequence acs_mail_lite_id_seq;
      drop table acs_mail_lite_mail_log;
      drop table acs_mail_lite_bounce;
      drop table acs_mail_lite_bounce_notif;
      drop TABLE acs_mail_lite_complex_queue;
      \ No newline at end of file
      sql/oracle/upgrade/upgrade-1.0b6-1.0b7.sql 0 → 100644
      View file @ d7e69903
      -- Make sure that emails are going to parties not to users and therefore logging is for parties, not for users.
      alter table acs_mail_lite_mail_log add column party_id integer references parties(party_id);
      update acs_mail_lite_mail_log set party_id = user_id;
      alter table acs_mail_lite_mail_log drop column user_id;
      alter table acs_mail_lite_bounce add column party_id integer references parties(party_id);
      update acs_mail_lite_bounce set party_id = user_id;
      alter table acs_mail_lite_bounce drop column user_id;
      \ No newline at end of file
      sql/oracle/upgrade/upgrade-1.3b7-1.3b8.sql 0 → 100644
      View file @ d7e69903
      -- 2006/11/17 cognovis/nfl
      --
      -- Name: acs_mail_lite_complex_queue; Type: TABLE; Schema: public; Owner: cognovis; Tablespace:
      --
      CREATE TABLE acs_mail_lite_complex_queue (
      id integer
      constraint acs_mail_lite_complex_queue_pk
      PRIMARY KEY,
      creation_date text,
      locking_server text,
      to_party_ids varchar(4000),
      cc_party_ids varchar(4000),
      bcc_party_ids varchar(4000),
      to_group_ids varchar(4000),
      cc_group_ids varchar(4000),
      bcc_group_ids varchar(4000),
      to_addr clob,
      cc_addr clob,
      bcc_addr clob,
      from_addr varchar(400),
      reply_to varchar(400),
      subject varchar(4000),
      body clob,
      package_id integer,
      files varchar(4000),
      file_ids varchar(4000),
      folder_ids varchar(4000),
      mime_type varchar(200),
      object_id integer,
      single_email_p varchar2(1)
      constraint acs_mail_lite_co_qu_single_em_p_ck
      check (valid_email_p in ('t','f')),
      no_callback_p varchar2(1)
      constraint acs_mail_lite_co_qu_no_callb_p_ck
      check (valid_email_p in ('t','f')),
      extraheaders clob,
      alternative_part_p varchar2(1)
      constraint acs_mail_lite_co_qu_alt_part_p_ck
      check (valid_email_p in ('t','f')),
      use_sender_p varchar2(1)
      constraint acs_mail_lite_co_qu_use_sender_p_ck
      check (valid_email_p in ('t','f'))
      );
      sql/oracle/upgrade/upgrade-1.3b8-1.3b9.sql 0 → 100644
      View file @ d7e69903
      -- Make sure that emails are going to parties not to users and therefore logging is for parties, not for users.
      alter table acs_mail_lite_bounce_notif drop constraint acs_mail_li_bou_notif_us_id_fk;
      alter table acs_mail_lite_bounce_notif add column party_id integer constraint acs_mail_li_bou_notif_us_id_fk references parties (party_id) on delete cascade;
      update acs_mail_lite_bounce_notif set party_id = user_id;
      alter table acs_mail_lite_bounce_notif drop column user_id;
      \ No newline at end of file
      sql/oracle/upgrade/upgrade-1.3b9-1.3b10.sql 0 → 100644
      View file @ d7e69903
      alter table acs_mail_lite_complex_queue add column reply_to varchar(400);
      \ No newline at end of file
      sql/postgresql/acs-mail-lite-create.sql
      View file @ d7e69903
      ......@@ -5,75 +5,86 @@
      -- @version $Id$
      --
      create sequence acs_mail_lite_id_seq;
      create table acs_mail_lite_queue (
      message_id integer
      constraint acs_mail_lite_queue_pk
      primary key,
      to_addr text,
      from_addr varchar(200),
      subject varchar(200),
      body text,
      extra_headers text,
      bcc text,
      package_id integer
      constraint acs_mail_lite_queue_pck_fk
      references apm_packages,
      valid_email_p boolean
      );
      create table acs_mail_lite_mail_log (
      party_id integer
      constraint acs_mail_lite_log_party_id_fk
      references parties (party_id)
      on delete cascade
      constraint acs_mail_lite_log_pk
      primary key,
      last_mail_date timestamptz default current_timestamp
      );
      create or replace function inline_0 ()
      returns integer as '
      DECLARE
      row RECORD;
      v_count integer;
      BEGIN
      select count(*) into v_count from user_tab_columns
      where lower(table_name) = ''acs_mail_lite_queue'';
      IF v_count > 0 THEN return 0; END IF;
      create sequence acs_mail_lite_id_seq;
      create table acs_mail_lite_queue (
      message_id integer
      constraint acs_mail_lite_queue_pk
      primary key,
      to_addr text,
      from_addr varchar(200),
      subject varchar(200),
      body text,
      extra_headers text,
      bcc text,
      package_id integer
      constraint acs_mail_lite_queue_pck_fk
      references apm_packages,
      valid_email_p boolean
      );
      create table acs_mail_lite_mail_log (
      user_id integer
      constraint acs_mail_lite_log_user_id_fk
      references users (user_id)
      on delete cascade
      constraint acs_mail_lite_log_pk
      primary key,
      last_mail_date timestamptz default current_timestamp
      );
      create table acs_mail_lite_bounce (
      user_id integer
      constraint acs_mail_lite_bou_user_id_fk
      references users (user_id)
      on delete cascade
      constraint acs_mail_lite_bou_pk
      primary key,
      bounce_count integer default 1
      );
      create table acs_mail_lite_bounce_notif (
      user_id integer
      constraint acs_mail_li_bou_notif_us_id_fk
      references users (user_id)
      on delete cascade
      constraint acs_mail_lite_notif_pk
      primary key,
      notification_time timestamptz default current_timestamp,
      notification_count integer default 0
      );
      create table acs_mail_lite_bounce (
      party_id integer
      constraint acs_mail_lite_bou_party_id_fk
      references parties (party_id)
      on delete cascade
      constraint acs_mail_lite_bou_pk
      primary key,
      bounce_count integer default 1
      );
      return 0;
      END;' language 'plpgsql';
      select inline_0 ();
      drop function inline_0 ();
      create table acs_mail_lite_bounce_notif (
      party_id integer
      constraint acs_mail_li_bou_notif_us_id_fk
      references parties (party_id)
      on delete cascade
      constraint acs_mail_lite_bounce_notif_pk
      primary key,
      notification_time timestamptz default current_timestamp,
      notification_count integer default 0
      );
      CREATE TABLE acs_mail_lite_complex_queue (
      id integer
      constraint acs_mail_lite_complex_queue_pk
      primary key,
      creation_date text,
      locking_server text,
      to_party_ids text,
      cc_party_ids text,
      bcc_party_ids text,
      to_group_ids text,
      cc_group_ids text,
      bcc_group_ids text,
      to_addr text,
      cc_addr text,
      bcc_addr text,
      from_addr text,
      reply_to text,
      subject text,
      body text,
      package_id integer,
      files text,
      file_ids text,
      folder_ids text,
      mime_type text,
      object_id integer,
      single_email_p boolean,
      no_callback_p boolean,
      extraheaders text,
      alternative_part_p boolean,
      use_sender_p boolean
      );
      sql/postgresql/acs-mail-lite-drop.sql
      View file @ d7e69903
      ......@@ -9,4 +9,5 @@ drop table acs_mail_lite_queue;
      drop sequence acs_mail_lite_id_seq;
      drop table acs_mail_lite_mail_log;
      drop table acs_mail_lite_bounce;
      drop table acs_mail_lite_bounce_notif;
      \ No newline at end of file
      drop table acs_mail_lite_bounce_notif;
      drop TABLE acs_mail_lite_complex_queue;
      sql/postgresql/upgrade/upgrade-1.0b6-1.0b7.sql 0 → 100644
      View file @ d7e69903
      -- Make sure that emails are going to parties not to users and therefore logging is for parties, not for users.
      alter table acs_mail_lite_mail_log add column party_id integer references parties(party_id);
      update acs_mail_lite_mail_log set party_id = user_id;
      alter table acs_mail_lite_mail_log drop column user_id;
      alter table acs_mail_lite_bounce add column party_id integer references parties(party_id);
      update acs_mail_lite_bounce set party_id = user_id;
      alter table acs_mail_lite_bounce drop column user_id;
      \ No newline at end of file
      sql/postgresql/upgrade/upgrade-1.3b7-1.3b8.sql 0 → 100644
      View file @ d7e69903
      -- 2006/11/17 cognovis/nfl
      --
      -- Name: acs_mail_lite_complex_queue; Type: TABLE; Schema: public; Owner: cognovis; Tablespace:
      --
      CREATE TABLE acs_mail_lite_complex_queue (
      id serial PRIMARY KEY,
      creation_date text,
      locking_server text,
      to_party_ids text,
      cc_party_ids text,
      bcc_party_ids text,
      to_group_ids text,
      cc_group_ids text,
      bcc_group_ids text,
      to_addr text,
      cc_addr text,
      bcc_addr text,
      from_addr text,
      subject text,
      body text,
      package_id integer,
      files text,
      file_ids text,
      folder_ids text,
      mime_type text,
      object_id integer,
      single_email_p boolean,
      no_callback_p boolean,
      extraheaders text,
      alternative_part_p boolean,
      use_sender_p boolean
      );
      --
      -- PostgreSQL database statements - end of file
      --
      sql/postgresql/upgrade/upgrade-1.3b8-1.3b9.sql 0 → 100644
      View file @ d7e69903
      -- Make sure that emails are going to parties not to users and therefore logging is for parties, not for users.
      alter table acs_mail_lite_bounce_notif drop constraint acs_mail_li_bou_notif_us_id_fk;
      alter table acs_mail_lite_bounce_notif add column party_id integer constraint acs_mail_li_bou_notif_us_id_fk references parties (party_id) on delete cascade;
      update acs_mail_lite_bounce_notif set party_id = user_id;
      alter table acs_mail_lite_bounce_notif drop column user_id;
      \ No newline at end of file
      sql/postgresql/upgrade/upgrade-1.3b9-1.3b10.sql 0 → 100644
      View file @ d7e69903
      alter table acs_mail_lite_complex_queue add column reply_to text;
      \ No newline at end of file
      tcl/acs-mail-lite-callback-procs.tcl 0 → 100644
      View file @ d7e69903
      # packages/acs-mail-lite/tcl/acs-mail-lite-callback-procs.tcl
      ad_library {
      Callback procs for acs-mail-lite
      @author Malte Sussdorff (sussdorff@sussdorff.de)
      @creation-date 2005-06-15
      @arch-tag: d9aec4df-102d-4b0d-8d0e-3dc470dbe783
      @cvs-id $Id$
      }
      ad_proc -public -callback acs_mail_lite::complex_send {
      {-package_id:required}
      {-from_party_id:required}
      {-from_addr ""}
      {-to_party_ids}
      {-cc_party_ids}
      {-bcc_party_ids}
      {-to_addr}
      {-cc_addr}
      {-bcc_addr}
      {-body}
      {-message_id:required}
      {-subject}
      {-object_id}
      {-file_ids}
      } {
      Callback for executing code after an email has been send using the complex send mechanism.
      @param from_party_id Who is sending the email
      @param to_party_ids list of ids to whom did we send this email
      @param cc_party_ids list of ids to whom did we send this email in "CC"
      @param bcc_party_ids list of ids to whom did we send this email in "BCC"
      @param to_addr string of emails seperated by "," to whom did we send this email
      @param cc_addr string of emails seperated by "," to whom did we send this email in CC
      @param bcc_addr string of emails seperated by "," to whom did we send this email in BCC
      @param subject of the email
      @param body Text body of the email
      @param package_id Package ID of the sending package
      @param file_ids List of file ids to be send as attachments. This will only work with files stored in the file system. The list is actually a string with the ids concated with a ",".
      @param object_id The ID of the object that is responsible for sending the mail in the first place
      @param message_id the generated message_id for this mail
      } -
      ad_proc -public -callback acs_mail_lite::send {
      {-package_id:required}
      {-from_party_id:required}
      {-to_party_id:required}
      {-body}
      {-message_id:required}
      {-subject}
      } {
      }
      ad_proc -public -callback acs_mail_lite::incoming_email {
      -array:required
      -package_id
      } {
      Callback that is executed for incoming e-mails if the email is *NOT* like $object_id@servername
      } -
      ad_proc -public -callback acs_mail_lite::incoming_object_email {
      -array:required
      -object_id:required
      } {
      Callback that is executed for incoming e-mails if the email is like $object_id@servername
      } -
      ad_proc -public -callback acs_mail_lite::email_form_elements {
      -varname:required
      } {
      }
      ad_proc -public -callback acs_mail_lite::files {
      -varname:required
      -recipient_ids:required
      } {
      }
      ad_proc -public -callback acs_mail_lite::incoming_email -impl acs-mail-lite {
      -array:required
      -package_id:required
      } {
      Implementation of the interface acs_mail_lite::incoming_email for acs-mail-lite. This proc
      takes care of emails bounced back from mailer deamons. The required syntax for the To header
      is as follows: EnvelopPrefix-user_id-signature-package_id@myhost.com. This email was set for
      the Return-Path header of the original email. The signature is created by calculating the SHA
      value of the original Message-Id header. Thus an email is valid if the signature is correct and
      the user is known. If this is the case we record the bounce.
      @author Nima Mazloumi (nima.mazloumi@gmx.de)
      @creation-date 2005-07-15
      @param array An array with all headers, files and bodies. To access the array you need to use upvar.
      @param package_id The package instance that registered the prefix
      @return nothing
      @error
      } {
      upvar $array email
      set to [acs_mail_lite::parse_email_address -email $email(to)]
      ns_log Debug "acs_mail_lite::incoming_email -impl acs-mail-lite called. Recepient $to"
      util_unlist [acs_mail_lite::parse_bounce_address -bounce_address $to] user_id package_id signature
      # If no user_id found or signature invalid, ignore message
      if {$user_id eq ""} {
      if {$user_id eq ""} {
      ns_log Debug "acs_mail_lite::incoming_email impl acs-mail-lite: No equivalent user found for $to"
      } else {
      ns_log Debug "acs_mail_lite::incoming_email impl acs-mail-lite: Invalid mail signature $signature"
      }
      } else {
      ns_log Debug "acs_mail_lite::incoming_email impl acs-mail-lite: Bounce checking $to, $user_id"
      if { ![acs_mail_lite::bouncing_user_p -user_id $user_id] } {
      ns_log Debug "acs_mail_lite::incoming_email impl acs-mail-lite: Bouncing email from user $user_id"
      # record the bounce in the database
      db_dml record_bounce {}
      if {![db_resultrows]} {
      db_dml insert_bounce {}
      }
      }
      }
      }
      tcl/acs-mail-lite-callback-procs.xql 0 → 100644
      View file @ d7e69903
      <?xml version="1.0"?>
      <queryset>
      <fullquery name="callback::acs_mail_lite::incoming_email::impl::acs-mail-lite.record_bounce">
      <querytext>
      update acs_mail_lite_bounce
      set bounce_count = bounce_count + 1
      where party_id = :user_id
      </querytext>
      </fullquery>
      <fullquery name="callback::acs_mail_lite::incoming_email::impl::acs-mail-lite.insert_bounce">
      <querytext>
      insert into acs_mail_lite_bounce (party_id, bounce_count)
      values (:user_id, 1)
      </querytext>
      </fullquery>
      </queryset>
      tcl/acs-mail-lite-init.tcl
      View file @ d7e69903
      ......@@ -10,11 +10,17 @@ ad_library {
      # Default interval is 1 minute.
      ad_schedule_proc -thread t 60 acs_mail_lite::sweeper
      # Run the complex_sweeper every 180s (3min)
      ad_schedule_proc -thread t 180 acs_mail_lite::complex_sweeper
      set queue_dir [parameter::get_from_package_key -parameter "BounceMailDir" -package_key "acs-mail-lite"]
      # ad_schedule_proc -thread t 120 acs_mail_lite::load_mails -queue_dir $queue_dir
      # check every few minutes for bounces
      ad_schedule_proc -thread t [acs_mail_lite::get_parameter -name BounceScanQueue -default 120] acs_mail_lite::scan_replies
      #ad_schedule_proc -thread t [acs_mail_lite::get_parameter -name BounceScanQueue -default 120] acs_mail_lite::scan_replies
      nsv_set acs_mail_lite send_mails_p 0
      nsv_set acs_mail_lite check_bounce_p 0
      ad_schedule_proc -thread t -schedule_proc ns_schedule_daily [list 0 25] acs_mail_lite::check_bounces
      # ad_schedule_proc -thread t -schedule_proc ns_schedule_daily [list 0 25] acs_mail_lite::check_bounces
      tcl/acs-mail-lite-procs-oracle.xql
      View file @ d7e69903
      ......@@ -3,55 +3,6 @@
      <queryset>
      <rdbms><type>oracle</type><version>8.1.6</version></rdbms>
      <fullquery name="acs_mail_lite::check_bounces.send_notification_to_bouncing_email">
      <querytext>
      insert into acs_mail_lite_bounce_notif
      (user_id, notification_count, notification_time)
      (select user_id, 0 as notification_count,
      trunc(sysdate-1-:notification_interval) as notification_time
      from acs_mail_lite_bounce
      where bounce_count >= :max_bounce_count)
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::check_bounces.get_recent_bouncing_users">
      <querytext>
      select u.user_id, u.email, u.first_names || ' ' || u.last_name as name
      from cc_users u, acs_mail_lite_bounce_notif n
      where u.user_id = n.user_id
      and u.email_bouncing_p = 't'
      and n.notification_time < sysdate - :notification_interval
      and n.notification_count < :max_notification_count
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::check_bounces.log_notication_sending">
      <querytext>
      update acs_mail_lite_bounce_notif
      set notification_time = trunc(sysdate),
      notification_count = notification_count + 1
      where user_id = :user_id
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::check_bounces.delete_log_if_no_recent_bounce">
      <querytext>
      delete from acs_mail_lite_bounce
      where user_id in (select user_id
      from acs_mail_lite_mail_log
      where last_mail_date < sysdate - :max_days_to_bounce)
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::send.create_queue_entry">
      <querytext>
      insert into acs_mail_lite_queue
      ......@@ -68,7 +19,7 @@
      update acs_mail_lite_mail_log
      set last_mail_date = sysdate
      where user_id = :user_id
      where party_id = :user_id
      </querytext>
      </fullquery>
      ......@@ -76,7 +27,7 @@
      <fullquery name="acs_mail_lite::log_mail_sending.insert_log_entry">
      <querytext>
      insert into acs_mail_lite_mail_log (user_id, last_mail_date)
      insert into acs_mail_lite_mail_log (party_id, last_mail_date)
      values (:user_id, sysdate)
      </querytext>
      ......
      tcl/acs-mail-lite-procs-postgresql.xql
      View file @ d7e69903
      ......@@ -3,55 +3,6 @@
      <queryset>
      <rdbms><type>postgresql</type><version>7.1</version></rdbms>
      <fullquery name="acs_mail_lite::check_bounces.send_notification_to_bouncing_email">
      <querytext>
      insert into acs_mail_lite_bounce_notif (user_id, notification_count, notification_time)
      select user_id, 0 as notification_count,
      date_trunc('day', current_timestamp - to_interval(1 + :notification_interval, 'days'))
      as notification_time
      from acs_mail_lite_bounce
      where bounce_count >= :max_bounce_count
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::check_bounces.get_recent_bouncing_users">
      <querytext>
      select u.user_id, u.email, u.first_names || ' ' || u.last_name as name
      from cc_users u, acs_mail_lite_bounce_notif n
      where u.user_id = n.user_id
      and u.email_bouncing_p = 't'
      and n.notification_time < current_timestamp - to_interval(:notification_interval, 'days')
      and n.notification_count < :max_notification_count
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::check_bounces.log_notication_sending">
      <querytext>
      update acs_mail_lite_bounce_notif
      set notification_time = date_trunc('day',current_timestamp),
      notification_count = notification_count + 1
      where user_id = :user_id
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::check_bounces.delete_log_if_no_recent_bounce">
      <querytext>
      delete from acs_mail_lite_bounce
      where user_id in (select user_id
      from acs_mail_lite_mail_log
      where last_mail_date < current_timestamp - to_interval(:max_days_to_bounce, 'days'))
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::send.create_queue_entry">
      <querytext>
      insert into acs_mail_lite_queue
      ......@@ -68,7 +19,7 @@
      update acs_mail_lite_mail_log
      set last_mail_date = current_timestamp
      where user_id = :user_id
      where party_id = :user_id
      </querytext>
      </fullquery>
      ......@@ -76,7 +27,7 @@
      <fullquery name="acs_mail_lite::log_mail_sending.insert_log_entry">
      <querytext>
      insert into acs_mail_lite_mail_log (user_id, last_mail_date)
      insert into acs_mail_lite_mail_log (party_id, last_mail_date)
      values (:user_id, current_timestamp)
      </querytext>
      ......@@ -114,5 +65,4 @@
      </querytext>
      </fullquery>
      </queryset>
      tcl/acs-mail-lite-procs.tcl
      View file @ d7e69903
      ......@@ -8,8 +8,12 @@ ad_library {
      }
      package require mime 1.4
      package require smtp 1.4
      package require base64 2.3.1
      namespace eval acs_mail_lite {
      #---------------------------------------
      ad_proc -public with_finally {
      -code:required
      -finally:required
      ......@@ -63,12 +67,14 @@ namespace eval acs_mail_lite {
      }
      }
      #---------------------------------------
      ad_proc -public get_package_id {} {
      @returns package_id of this package
      } {
      return [apm_package_id_from_key acs-mail-lite]
      }
      #---------------------------------------
      ad_proc -public get_parameter {
      -name:required
      {-default ""}
      ......@@ -81,34 +87,7 @@ namespace eval acs_mail_lite {
      return [parameter::get -package_id [get_package_id] -parameter $name -default $default]
      }
      ad_proc -public address_domain {} {
      @returns domain address to which bounces are directed to
      } {
      set domain [get_parameter -name "BounceDomain"]
      if { [empty_string_p $domain] } {
      set domain [ns_info hostname]
      }
      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
      } {
      ......@@ -123,26 +102,8 @@ namespace eval acs_mail_lite {
      }
      }
      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
      } {
      ......@@ -155,37 +116,8 @@ namespace eval acs_mail_lite {
      }
      }
      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 Notice "acs-mail-lite: bounce_address not found"
      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.
      ......@@ -197,207 +129,24 @@ namespace eval acs_mail_lite {
      return "<[clock clicks].[ns_time].oacs@[address_domain]>"
      }
      #---------------------------------------
      ad_proc -public valid_signature {
      -signature:required
      -msg:required
      -message_id:required
      } {
      Validates if provided signature matches message_id
      @option signature signature to be checked
      @option msg message-id that the signature should be checked against
      @returns boolean 0 or 1
      } {
      if {![regexp "Message-Id: (<\[\-0-9\]+\\.\[0-9\]+\\.oacs@[address_domain]>)\n" $msg match message_id] || ![string equal $signature [ns_sha1 $message_id]]} {
      if {![regexp "(<\[\-0-9\]+\\.\[0-9\]+\\.oacs@[address_domain]>)" $message_id match id] || $signature ne [ns_sha1 $id] } {
      # either couldn't find message-id or signature doesn't match
      return 0
      }
      return 1
      }
      ad_proc -private load_mail_dir {
      -queue_dir:required
      } {
      Scans qmail incoming email queue for bounced mail and processes
      these bounced mails.
      @author ben@openforce.net
      @author dan.wickstrom@openforce.net
      @creation-date 22 Sept, 2001
      @option queue_dir The location of the qmail mail queue in the file-system.
      } {
      if {[catch {
      # get list of all incoming mail
      set messages [glob "$queue_dir/new/*"]
      } errmsg]} {
      ns_log Notice "queue dir = $queue_dir/new/*, no messages"
      return [list]
      }
      set list_of_bounce_ids [list]
      set new_messages_p 0
      # loop over every incoming mail
      foreach msg $messages {
      ns_log Notice "opening file: $msg"
      if [catch {set f [open $msg r]}] {
      continue
      }
      set file [read $f]
      close $f
      set file [split $file "\n"]
      set new_messages 1
      set end_of_headers_p 0
      set i 0
      set line [lindex $file $i]
      set headers [list]
      # walk through the headers and extract each one
      while ![empty_string_p $line] {
      set next_line [lindex $file [expr $i + 1]]
      if {[regexp {^[ ]*$} $next_line match] && $i > 0} {
      set end_of_headers_p 1
      }
      if {[regexp {^([^:]+):[ ]+(.+)$} $line match name value]} {
      # join headers that span more than one line (e.g. Received)
      if { ![regexp {^([^:]+):[ ]+(.+)$} $next_line match] && !$end_of_headers_p} {
      append line $next_line
      incr i
      }
      lappend headers [string tolower $name] $value
      if {$end_of_headers_p} {
      incr i
      break
      }
      } else {
      # The headers and the body are delimited by a null line as specified by RFC822
      if {[regexp {^[ ]*$} $line match]} {
      incr i
      break
      }
      }
      incr i
      set line [lindex $file $i]
      }
      set body "\n[join [lrange $file $i end] "\n"]"
      # okay now we have a list of headers and the body, let's
      # put it into notifications stuff
      array set email_headers $headers
      if [catch {set from $email_headers(from)}] {
      set from ""
      }
      if [catch {set to $email_headers(to)}] {
      set to ""
      }
      set to [parse_email_address -email $to]
      ns_log Notice "acs-mail-lite: To: $to"
      util_unlist [parse_bounce_address -bounce_address $to] user_id package_id signature
      # If no user_id found or signature invalid, ignore message
      if {[empty_string_p $user_id] || ![valid_signature -signature $signature -msg $body]} {
      if {[empty_string_p $user_id]} {
      ns_log Notice "acs-mail-lite: No user id $user_id found"
      } else {
      ns_log Notice "acs-mail-lite: Invalid mail signature"
      }
      if {[catch {ns_unlink $msg} errmsg]} {
      ns_log Notice "acs-mail-lite: couldn't remove message"
      }
      continue
      }
      # Try to invoke package-specific procedure for special treatment
      # of mail bounces
      catch {acs_sc::invoke -contract AcsMailLite -operation MailBounce -impl [string map {- _} [apm_package_key_from_id $package_id]] -call_args [list [array get email_headers] $body]}
      # Okay, we have a bounce for a system user
      # Check if the user has been marked as bouncing mail
      # if the user is bouncing mail, we simply disgard the
      # bounce since it was sent before the user's email was
      # disabled.
      ns_log Notice "Bounce checking: $to, $user_id"
      if { ![bouncing_user_p -user_id $user_id] } {
      ns_log Notice "acs-mail-lite: Bouncing email from user $user_id"
      # record the bounce in the database
      db_dml record_bounce {}
      if {![db_resultrows]} {
      db_dml insert_bounce {}
      }
      }
      catch {ns_unlink $msg}
      }
      }
      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 Notice "acs-mail-lite: about to load qmail queue"
      load_mail_dir -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
      ......@@ -444,8 +193,8 @@ namespace eval acs_mail_lite {
      #-----------------------------------------------------
      set delivery_mode [ns_config ns/server/[ns_info server]/acs/acs-rollout-support EmailDeliveryMode]
      if {![empty_string_p $delivery_mode]
      && ![string equal $delivery_mode default]
      if {$delivery_mode ne ""
      && $delivery_mode ne "default"
      } {
      # The to_addr has been put in an array, and returned. Now
      # it is of the form: email email_address name namefromdb
      ......@@ -455,10 +204,10 @@ namespace eval acs_mail_lite {
      ns_sendmail $to_address $from_addr $subject $body $eh $bcc
      } else {
      if { [string equal [bounce_sendmail] "SMTP"] } {
      if {[bounce_sendmail] eq "SMTP"} {
      ## Terminate body with a solitary period
      foreach line [split $msg "\n"] {
      if {[string match . [string trim $line]]} {
      if {"." eq [string trim $line]} {
      append data .
      }
      #AG: ensure no \r\r\n terminations.
      ......@@ -468,13 +217,13 @@ namespace eval acs_mail_lite {
      append data .
      smtp -from_addr $from_addr -sendlist $to_addr -msg $data -valid_email_p $valid_email_p -message_id $message_id -package_id $package_id
      if {![empty_string_p $bcc]} {
      if {$bcc ne ""} {
      smtp -from_addr $from_addr -sendlist $bcc -msg $data -valid_email_p $valid_email_p -message_id $message_id -package_id $package_id
      }
      } else {
      sendmail -from_addr $from_addr -sendlist $to_addr -msg $msg -valid_email_p $valid_email_p -message_id $message_id -package_id $package_id
      if {![empty_string_p $bcc]} {
      if {$bcc ne ""} {
      sendmail -from_addr $from_addr -sendlist $bcc -msg $msg -valid_email_p $valid_email_p -message_id $message_id -package_id $package_id
      }
      }
      ......@@ -483,11 +232,13 @@ namespace eval acs_mail_lite {
      }
      }
      #---------------------------------------
      ad_proc -private sendmail {
      -from_addr:required
      -sendlist:required
      -msg:required
      {-valid_email_p 0}
      {-cc ""}
      -message_id:required
      -package_id:required
      } {
      ......@@ -503,34 +254,42 @@ namespace eval acs_mail_lite {
      (needed to call package-specific code to deal with bounces)
      } {
      array set rcpts $sendlist
      foreach rcpt $rcpts(email) rcpt_id $rcpts(user_id) rcpt_name $rcpts(name) {
      if { $valid_email_p || ![bouncing_email_p -email $rcpt] } {
      with_finally -code {
      set sendmail [list [bounce_sendmail] "-f[bounce_address -user_id $rcpt_id -package_id $package_id -message_id $message_id]" "-t" "-i"]
      # add username if it exists
      if {![empty_string_p $rcpt_name]} {
      set pretty_to "$rcpt_name <$rcpt>"
      } else {
      set pretty_to $rcpt
      if {[info exists rcpts(email)]} {
      foreach rcpt $rcpts(email) rcpt_id $rcpts(user_id) rcpt_name $rcpts(name) {
      if { $valid_email_p || ![bouncing_email_p -email $rcpt] } {
      with_finally -code {
      set sendmail [list [bounce_sendmail] "-f[bounce_address -user_id $rcpt_id -package_id $package_id -message_id $message_id]" "-t" "-i"]
      # add username if it exists
      if {$rcpt_name ne ""} {
      set pretty_to "$rcpt_name <$rcpt>"
      } else {
      set pretty_to $rcpt
      }
      # substitute all "\r\n" with "\n", because piped text should only contain "\n"
      regsub -all "\r\n" $msg "\n" msg
      if {[catch {
      set err1 {}
      set f [open "|$sendmail" "w"]
      puts $f "From: $from_addr\nTo: $pretty_to\nCC: $cc\n$msg"
      set err1 [close $f]
      } err2]} {
      ns_log Error "Attempt to send From: $from_addr\nTo: $pretty_to\n$msg failed.\nError $err1 : $err2"
      }
      } -finally {
      }
      # substitute all "\r\n" with "\n", because piped text should only contain "\n"
      regsub -all "\r\n" $msg "\n" msg
      set f [open "|$sendmail" "w"]
      puts $f "From: $from_addr\nTo: $pretty_to\n$msg"
      close $f
      } -finally {
      } else {
      ns_log Notice "acs-mail-lite: Email bouncing from $rcpt, mail not sent and deleted from queue"
      }
      } else {
      ns_log Notice "acs-mail-lite: Email bouncing from $rcpt, mail not sent and deleted from queue"
      # log mail sending time
      if {$rcpt_id ne ""} { log_mail_sending -user_id $rcpt_id }
      }
      # log mail sending time
      if {![empty_string_p $rcpt_id]} { log_mail_sending -user_id $rcpt_id }
      }
      }
      #---------------------------------------
      ad_proc -private smtp {
      -from_addr:required
      -sendlist:required
      ......@@ -551,25 +310,25 @@ namespace eval acs_mail_lite {
      (needed to call package-specific code to deal with bounces)
      } {
      set smtp [ns_config ns/parameters smtphost]
      if {[empty_string_p $smtp]} {
      if {$smtp eq ""} {
      set smtp [ns_config ns/parameters mailhost]
      }
      if {[empty_string_p $smtp]} {
      if {$smtp eq ""} {
      set smtp localhost
      }
      set timeout [ns_config ns/parameters smtptimeout]
      if {[empty_string_p $timeout]} {
      if {$timeout eq ""} {
      set timeout 60
      }
      set smtpport [ns_config ns/parameters smtpport]
      if {[empty_string_p $smtpport]} {
      if {$smtpport eq ""} {
      set smtpport 25
      }
      array set rcpts $sendlist
      foreach rcpt $rcpts(email) rcpt_id $rcpts(user_id) rcpt_name $rcpts(name) {
      if { $valid_email_p || ![bouncing_email_p -email $rcpt] } {
      # add username if it exists
      if {![empty_string_p $rcpt_name]} {
      if {$rcpt_name ne ""} {
      set pretty_to "$rcpt_name <$rcpt>"
      } else {
      set pretty_to $rcpt
      ......@@ -582,7 +341,7 @@ namespace eval acs_mail_lite {
      set sock [ns_sockopen $smtp $smtpport]
      set rfp [lindex $sock 0]
      set wfp [lindex $sock 1]
      ## Perform the SMTP conversation
      with_finally -code {
      _ns_smtp_recv $rfp 220 $timeout
      ......@@ -590,14 +349,38 @@ namespace eval acs_mail_lite {
      _ns_smtp_recv $rfp 250 $timeout
      _ns_smtp_send $wfp "MAIL FROM:<$mail_from>" $timeout
      _ns_smtp_recv $rfp 250 $timeout
      _ns_smtp_send $wfp "RCPT TO:<$rcpt>" $timeout
      _ns_smtp_recv $rfp 250 $timeout
      # By now we are sure that the server connection works, otherwise
      # we would have gotten an error already
      if {[catch {
      _ns_smtp_send $wfp "RCPT TO:<$rcpt>" $timeout
      _ns_smtp_recv $rfp 250 $timeout
      } errmsg]} {
      # This user has a problem with retrieving the email
      # Record this fact as a bounce e-mail
      if { $rcpt_id ne "" && ![bouncing_user_p -user_id $rcpt_id] } {
      ns_log Notice "acs-mail-lite: Bouncing email from user $rcpt_id due to $errmsg"
      # record the bounce in the database
      db_dml record_bounce {}
      if {![db_resultrows]} {
      db_dml insert_bounce {}
      }
      }
      return
      }
      _ns_smtp_send $wfp DATA $timeout
      _ns_smtp_recv $rfp 354 $timeout
      _ns_smtp_send $wfp $msg $timeout
      _ns_smtp_recv $rfp 250 $timeout
      _ns_smtp_send $wfp QUIT $timeout
      _ns_smtp_recv $rfp 221 $timeout
      } -finally {
      ## Close the connection
      close $rfp
      ......@@ -607,10 +390,11 @@ namespace eval acs_mail_lite {
      ns_log Notice "acs-mail-lite: Email bouncing from $rcpt, mail not sent and deleted from queue"
      }
      # log mail sending time
      if {![empty_string_p $rcpt_id]} { log_mail_sending -user_id $rcpt_id }
      if {$rcpt_id ne ""} { log_mail_sending -user_id $rcpt_id }
      }
      }
      #---------------------------------------
      ad_proc -private get_address_array {
      -addresses:required
      } { Checks if passed variable is already an array of emails,
      ......@@ -656,6 +440,7 @@ namespace eval acs_mail_lite {
      return [array get address_array]
      }
      #---------------------------------------
      ad_proc -public send {
      -send_immediately:boolean
      -valid_email:boolean
      ......@@ -666,6 +451,7 @@ namespace eval acs_mail_lite {
      {-extraheaders ""}
      {-bcc ""}
      {-package_id ""}
      -no_callback:boolean
      } {
      Reliably send an email message.
      ......@@ -675,21 +461,26 @@ namespace eval acs_mail_lite {
      @option from_addr mail sender
      @option subject mail subject
      @option body mail body
      @option extraheaders extra mail headers
      @option extraheaders extra mail headers in an ns_set
      @option bcc see to_addr
      @option package_id To be used for calling a package-specific proc when mail has bounced
      @returns the Message-Id of the mail
      @option no_callback_p Boolean that indicates if callback should be executed or not. If you don't provide it it will execute callbacks
      @returns the Message-Id of the mail or an empty string if e-mail was discarded
      } {
      ## Extract "from" email address
      set from_addr [parse_email_address -email $from_addr]
      set from_party_id [party::get_by_email -email $from_addr]
      set to_party_id [party::get_by_email -email $to_addr]
      ## Get address-array with email, name and user_id
      set to_addr [get_address_array -addresses [string map {\n "" \r ""} $to_addr]]
      if {![empty_string_p $bcc]} {
      if {$bcc ne ""} {
      set bcc [get_address_array -addresses [string map {\n "" \r ""} $bcc]]
      }
      if {![empty_string_p $extraheaders]} {
      if {$extraheaders ne ""} {
      set eh_list [util_ns_set_to_list -set $extraheaders]
      } else {
      set eh_list ""
      ......@@ -701,8 +492,8 @@ namespace eval acs_mail_lite {
      set message_id [generate_message_id]
      lappend eh_list "Message-Id" $message_id
      if {[empty_string_p $package_id]} {
      if [ad_conn -connected_p] {
      if {$package_id eq ""} {
      if {[ad_conn -connected_p]} {
      set package_id [ad_conn package_id]
      } else {
      set package_id ""
      ......@@ -723,16 +514,33 @@ namespace eval acs_mail_lite {
      set send_p [parameter::get -package_id [get_package_id] -parameter "send_immediately" -default 0]
      }
      # if send_p true, then start acs_mail_lite::send_immediately, so mail is not stored in the db before delivery
      if { $send_p } {
      acs_mail_lite::send_immediately -to_addr $to_addr -from_addr $from_addr -subject $subject -body $body -extraheaders $eh_list -bcc $bcc -valid_email_p $valid_email_p -package_id $package_id
      if {$to_addr ne ""} {
      # if send_p true, then start acs_mail_lite::send_immediately, so mail is not stored in the db before delivery
      if { $send_p } {
      acs_mail_lite::send_immediately -to_addr $to_addr -from_addr $from_addr -subject $subject -body $body -extraheaders $eh_list -bcc $bcc -valid_email_p $valid_email_p -package_id $package_id
      } else {
      # else, store it in the db and let the sweeper deliver the mail
      db_dml create_queue_entry {}
      }
      if { !$no_callback_p } {
      callback acs_mail_lite::send \
      -package_id $package_id \
      -from_party_id $from_party_id \
      -to_party_id $to_party_id \
      -body $body \
      -message_id $message_id \
      -subject $subject
      }
      return $message_id
      } else {
      # else, store it in the db and let the sweeper deliver the mail
      db_dml create_queue_entry {}
      return ""
      }
      return $message_id
      }
      #---------------------------------------
      ad_proc -private sweeper {} {
      Send messages in the acs_mail_lite_queue table.
      } {
      ......@@ -759,6 +567,7 @@ namespace eval acs_mail_lite {
      }
      }
      #---------------------------------------
      ad_proc -private send_immediately {
      -to_addr:required
      -from_addr:required
      ......@@ -787,27 +596,29 @@ namespace eval acs_mail_lite {
      ns_log "Notice" "Mail info will be written in the db"
      db_dml create_queue_entry {}
      } else {
      ns_log "Notice" "acs_mail_lite::deliver_mail successful"
      ns_log "Debug" "acs_mail_lite::deliver_mail successful"
      }
      }
      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)
      #---------------------------------------
      ad_proc -private message_interpolate {
      {-values:required}
      {-text:required}
      } {
      Interpolates a set of values into a string. This is directly copied from the bulk mail package
      @param values a list of key, value pairs, each one consisting of a
      target string and the value it is to be replaced with.
      @param text the string that is to be interpolated
      @return the interpolated string
      } {
      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"
      foreach pair $values {
      regsub -all [lindex $pair 0] $text [lindex $pair 1] text
      }
      return $text
      }
      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
      }
      }
      tcl/acs-mail-lite-procs.xql
      View file @ d7e69903
      <?xml version="1.0"?>
      <queryset>
      <fullquery name="acs_mail_lite::bouncing_email_p.bouncing_p">
      <querytext>
      select case when email_bouncing_p = 't' then 1 else 0 end
      as send_p
      from cc_users
      where lower(email) = lower(:email)
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::bouncing_user_p.bouncing_p">
      <querytext>
      select case when email_bouncing_p = 't' then 1 else 0 end
      as send_p
      from cc_users
      where user_id = :user_id
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::log_mail_sending.record_mail_sent">
      <querytext>
      update acs_mail_lite_mail_log
      set last_mail_date = sysdate
      where user_id = :user_id
      where party_id = :user_id
      </querytext>
      </fullquery>
      ......@@ -37,59 +14,27 @@
      <fullquery name="acs_mail_lite::log_mail_sending.insert_log_entry">
      <querytext>
      insert into acs_mail_lite_mail_log (user_id, last_mail_date)
      insert into acs_mail_lite_mail_log (party_id, last_mail_date)
      values (:user_id, sysdate)
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::load_mail_dir.record_bounce">
      <fullquery name="acs_mail_lite::smtp.record_bounce">
      <querytext>
      update acs_mail_lite_bounce
      set bounce_count = bounce_count + 1
      where user_id = :user_id
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::load_mail_dir.insert_bounce">
      <querytext>
      insert into acs_mail_lite_bounce (user_id, bounce_count)
      values (:user_id, 1)
      where party_id = :rcpt_id
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::check_bounces.delete_log_if_no_recent_bounce">
      <fullquery name="acs_mail_lite::smtp.insert_bounce">
      <querytext>
      delete from acs_mail_lite_bounce
      where user_id in (select user_id
      from acs_mail_lite_mail_log
      where last_mail_date < sysdate - :max_days_to_bounce)
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::check_bounces.disable_bouncing_email">
      <querytext>
      update users
      set email_bouncing_p = 't'
      where user_id in (select user_id
      from acs_mail_lite_bounce
      where bounce_count >= :max_bounce_count)
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::check_bounces.delete_bouncing_users_from_log">
      <querytext>
      delete from acs_mail_lite_bounce
      where bounce_count >= :max_bounce_count
      insert into acs_mail_lite_bounce (party_id, bounce_count)
      values (:rcpt_id, 1)
      </querytext>
      </fullquery>
      ......@@ -97,9 +42,12 @@
      <fullquery name="acs_mail_lite::get_address_array.get_user_name_and_id">
      <querytext>
      select user_id, first_names || ' ' || last_name as user_name
      from cc_users
      select person_id as user_id, first_names || ' ' || last_name as user_name
      from parties, persons
      where email = :email
      and party_id = person_id
      order by party_id desc
      limit 1
      </querytext>
      </fullquery>
      ......@@ -114,6 +62,4 @@
      </fullquery>
      </queryset>
      tcl/bounce-procs-oracle.xql 0 → 100644
      View file @ d7e69903
      <?xml version="1.0"?>
      <queryset>
      <rdbms><type>oracle</type><version>8.1.6</version></rdbms>
      <fullquery name="acs_mail_lite::check_bounces.send_notification_to_bouncing_email">
      <querytext>
      insert into acs_mail_lite_bounce_notif
      (party_id, notification_count, notification_time)
      (select user_id, 0 as notification_count,
      trunc(sysdate-1-:notification_interval) as notification_time
      from acs_mail_lite_bounce
      where bounce_count >= :max_bounce_count)
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::check_bounces.get_recent_bouncing_users">
      <querytext>
      select u.user_id, u.email, u.first_names || ' ' || u.last_name as name
      from cc_users u, acs_mail_lite_bounce_notif n
      where u.user_id = n.party_id
      and u.email_bouncing_p = 't'
      and n.notification_time < sysdate - :notification_interval
      and n.notification_count < :max_notification_count
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::check_bounces.log_notication_sending">
      <querytext>
      update acs_mail_lite_bounce_notif
      set notification_time = trunc(sysdate),
      notification_count = notification_count + 1
      where party_id = :user_id
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::check_bounces.delete_log_if_no_recent_bounce">
      <querytext>
      delete from acs_mail_lite_bounce
      where party_id in (select party_id
      from acs_mail_lite_mail_log
      where last_mail_date < sysdate - :max_days_to_bounce)
      </querytext>
      </fullquery>
      </queryset>
      tcl/bounce-procs-postgresql.xql 0 → 100644
      View file @ d7e69903
      <?xml version="1.0"?>
      <queryset>
      <rdbms><type>postgresql</type><version>7.1</version></rdbms>
      <fullquery name="acs_mail_lite::check_bounces.send_notification_to_bouncing_email">
      <querytext>
      insert into acs_mail_lite_bounce_notif (party_id, notification_count, notification_time)
      select party_id, 0 as notification_count,
      date_trunc('day', current_timestamp - to_interval(1 + :notification_interval, 'days'))
      as notification_time
      from acs_mail_lite_bounce
      where bounce_count >= :max_bounce_count
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::check_bounces.get_recent_bouncing_users">
      <querytext>
      select u.user_id, u.email, u.first_names || ' ' || u.last_name as name
      from cc_users u, acs_mail_lite_bounce_notif n
      where u.user_id = n.party_id
      and u.email_bouncing_p = 't'
      and n.notification_time < current_timestamp - to_interval(:notification_interval, 'days')
      and n.notification_count < :max_notification_count
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::check_bounces.log_notication_sending">
      <querytext>
      update acs_mail_lite_bounce_notif
      set notification_time = date_trunc('day',current_timestamp),
      notification_count = notification_count + 1
      where party_id = :user_id
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::check_bounces.delete_log_if_no_recent_bounce">
      <querytext>
      delete from acs_mail_lite_bounce
      where party_id in (select party_id
      from acs_mail_lite_mail_log
      where last_mail_date < current_timestamp - to_interval(:max_days_to_bounce, 'days'))
      </querytext>
      </fullquery>
      </queryset>
      tcl/bounce-procs.tcl 0 → 100644
      View file @ d7e69903
      ad_library {
      Provides a simple API for reliably sending email.
      @author Eric Lorenzo (eric@openforce.net)
      @creation-date 22 March 2002
      @cvs-id $Id$
      }
      package require mime 1.4
      package require smtp 1.4
      package require base64 2.3.1
      namespace eval acs_mail_lite {
      #---------------------------------------
      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 -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 -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 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 {}
      }
      }
      }
      tcl/bounce-procs.xql 0 → 100755
      View file @ d7e69903
      <?xml version="1.0"?>
      <queryset>
      <fullquery name="acs_mail_lite::bouncing_email_p.bouncing_p">
      <querytext>
      select case when email_bouncing_p = 't' then 1 else 0 end
      as send_p
      from users, parties
      where lower(email) = lower(:email)
      and party_id = user_id
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::bouncing_user_p.bouncing_p">
      <querytext>
      select case when email_bouncing_p = 't' then 1 else 0 end
      as send_p
      from users
      where user_id = :user_id
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::check_bounces.delete_log_if_no_recent_bounce">
      <querytext>
      delete from acs_mail_lite_bounce
      where party_id in (select party_id
      from acs_mail_lite_mail_log
      where last_mail_date < sysdate - :max_days_to_bounce)
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::check_bounces.disable_bouncing_email">
      <querytext>
      update users
      set email_bouncing_p = 't'
      where user_id in (select party_id
      from acs_mail_lite_bounce
      where bounce_count >= :max_bounce_count)
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::check_bounces.delete_bouncing_users_from_log">
      <querytext>
      delete from acs_mail_lite_bounce
      where bounce_count >= :max_bounce_count
      </querytext>
      </fullquery>
      </queryset>
      tcl/complex-send-procs-oracle.xql 0 → 100644
      View file @ d7e69903
      <?xml version="1.0"?>
      <queryset>
      <rdbms><type>oracle</type><version>8.1.6</version></rdbms>
      <fullquery name="acs_mail_lite::complex_send.create_complex_queue_entry">
      <querytext>
      insert into acs_mail_lite_complex_queue
      (id,
      creation_date,
      locking_server,
      to_party_ids,
      cc_party_ids,
      bcc_party_ids,
      to_group_ids,
      cc_group_ids,
      bcc_group_ids,
      to_addr,
      cc_addr,
      bcc_addr,
      from_addr,
      reply_to,
      subject,
      body,
      package_id,
      files,
      file_ids,
      folder_ids,
      mime_type,
      object_id,
      single_email_p,
      no_callback_p,
      extraheaders,
      alternative_part_p,
      use_sender_p
      )
      values
      (acs_mail_lite_id_seq.nextval,
      :creation_date,
      :locking_server,
      :to_party_ids,
      :cc_party_ids,
      :bcc_party_ids,
      :to_group_ids,
      :cc_group_ids,
      :bcc_group_ids,
      :to_addr,
      :cc_addr,
      :bcc_addr,
      :from_addr,
      :reply_to,
      :subject,
      :body,
      :package_id,
      :files,
      :file_ids,
      :folder_ids,
      :mime_type,
      :object_id,
      decode(:single_email_p,'1','t','f'),
      decode(:no_callback_p,'1','t','f'),
      :extraheaders,
      decode(:alternative_part_p,'1','t','f'),
      decode(:use_sender_p,'1','t','f')
      )
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::complex_sweeper.get_complex_queued_messages">
      <querytext>
      select
      id,
      creation_date,
      locking_server,
      to_party_ids,
      cc_party_ids,
      bcc_party_ids,
      to_group_ids,
      cc_group_ids,
      bcc_group_ids,
      to_addr,
      cc_addr,
      bcc_addr,
      from_addr,
      subject,
      body,
      package_id,
      files,
      file_ids,
      folder_ids,
      mime_type,
      object_id,
      decode(single_email_p,'t',1,0) as single_email_p,
      decode(no_callback_p,'t',1,0) as no_callback_p,
      extraheaders,
      decode(alternative_part_p,'t',1,0) as alternative_part_p,
      decode(use_sender_p,'t',1,0) as use_sender_p
      from acs_mail_lite_complex_queue
      where locking_server = '' or locking_server is NULL
      </querytext>
      </fullquery>
      </queryset>
      tcl/complex-send-procs-postgresql.xql 0 → 100644
      View file @ d7e69903
      <?xml version="1.0"?>
      <queryset>
      <rdbms><type>postgresql</type><version>7.1</version></rdbms>
      <fullquery name="acs_mail_lite::complex_send.create_complex_queue_entry">
      <querytext>
      insert into acs_mail_lite_complex_queue
      (id,
      creation_date,
      locking_server,
      to_party_ids,
      cc_party_ids,
      bcc_party_ids,
      to_group_ids,
      cc_group_ids,
      bcc_group_ids,
      to_addr,
      cc_addr,
      bcc_addr,
      from_addr,
      reply_to,
      subject,
      body,
      package_id,
      files,
      file_ids,
      folder_ids,
      mime_type,
      object_id,
      single_email_p,
      no_callback_p,
      extraheaders,
      alternative_part_p,
      use_sender_p
      )
      values
      (nextval('acs_mail_lite_id_seq'),
      :creation_date,
      :locking_server,
      :to_party_ids,
      :cc_party_ids,
      :bcc_party_ids,
      :to_group_ids,
      :cc_group_ids,
      :bcc_group_ids,
      :to_addr,
      :cc_addr,
      :bcc_addr,
      :from_addr,
      :reply_to,
      :subject,
      :body,
      :package_id,
      :files,
      :file_ids,
      :folder_ids,
      :mime_type,
      :object_id,
      (case when :single_email_p = '1' then TRUE else FALSE end),
      (case when :no_callback_p = '1' then TRUE else FALSE end),
      :extraheaders,
      (case when :alternative_part_p = '1' then TRUE else FALSE end),
      (case when :use_sender_p = '1' then TRUE else FALSE end)
      )
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::complex_sweeper.get_complex_queued_messages">
      <querytext>
      select
      id,
      creation_date,
      locking_server,
      to_party_ids,
      cc_party_ids,
      bcc_party_ids,
      to_group_ids,
      cc_group_ids,
      bcc_group_ids,
      to_addr,
      cc_addr,
      bcc_addr,
      from_addr,
      reply_to,
      subject,
      body,
      package_id,
      files,
      file_ids,
      folder_ids,
      mime_type,
      object_id,
      (case when single_email_p = TRUE then 1 else 0 end) as single_email_p,
      (case when no_callback_p = TRUE then 1 else 0 end) as no_callback_p,
      extraheaders,
      (case when alternative_part_p = TRUE then 1 else 0 end) as alternative_part_p,
      (case when use_sender_p = TRUE then 1 else 0 end) as use_sender_p
      from acs_mail_lite_complex_queue
      where locking_server = '' or locking_server is NULL
      </querytext>
      </fullquery>
      </queryset>
      tcl/complex-send-procs.tcl 0 → 100644
      View file @ d7e69903
      namespace eval acs_mail_lite {
      #---------------------------------------
      # complex_send
      # created ... by ...
      # modified 2006/07/25 by nfl: new param. alternative_part_p
      # and creation of multipart/alternative
      # 2006/../.. new created as an frontend to the old complex_send that now is called complex_send_immediatly
      # 2006/11/17 modified (nfl)
      #---------------------------------------
      ad_proc -public complex_send {
      -send_immediately:boolean
      -valid_email:boolean
      {-to_party_ids ""}
      {-cc_party_ids ""}
      {-bcc_party_ids ""}
      {-to_group_ids ""}
      {-cc_group_ids ""}
      {-bcc_group_ids ""}
      {-to_addr ""}
      {-cc_addr ""}
      {-bcc_addr ""}
      -from_addr:required
      {-reply_to ""}
      {-subject ""}
      -body:required
      {-package_id ""}
      {-files ""}
      {-file_ids ""}
      {-folder_ids ""}
      {-mime_type "text/plain"}
      {-object_id ""}
      {-single_email_p ""}
      {-no_callback_p ""}
      {-extraheaders ""}
      {-alternative_part_p ""}
      -single_email:boolean
      -no_callback:boolean
      -use_sender:boolean
      } {
      Prepare an email to be send with the option to pass in a list
      of file_ids as well as specify an html_body and a mime_type. It also supports multiple "TO" recipients as well as CC
      and BCC recipients. Runs entirely off MIME and SMTP to achieve this.
      For backward compatibility a switch "single_email_p" is added.
      @param send_immediately The email is send immediately and not stored in the acs_mail_lite_queue
      @param to_party_ids list of party ids to whom we send this email
      @param cc_party_ids list of party ids to whom we send this email in "CC"
      @param bcc_party_ids list of party ids to whom we send this email in "BCC"
      @param to_party_ids list of group_ids to whom we send this email
      @param cc_party_ids list of group_ids to whom we send this email in "CC"
      @param bcc_party_ids list of group_ids to whom we send this email in "BCC"
      @param to_addr List of e-mail addresses to send this mail to. We will figure out the name if possible.
      @param from_addr E-Mail address of the sender. We will try to figure out the name if possible.
      @param subject of the email
      @param body Text body of the email
      @param cc_addr List of CC Users e-mail addresses to send this mail to. We will figure out the name if possible. Only useful if single_email is provided. Otherwise the CC users will be send individual emails.
      @param bcc_addr List of CC Users e-mail addresses to send this mail to. We will figure out the name if possible. Only useful if single_email is provided. Otherwise the CC users will be send individual emails.
      @param package_id Package ID of the sending package
      @param files List of file_title, mime_type, file_path (as in full path to the file) combination of files to be attached
      @param folder_ids ID of the folder who's content will be send along with the e-mail.
      @param file_ids List of file ids (items or revisions) to be send as attachments. This will only work with files stored in the file system.
      @param mime_type MIME Type of the mail to send out. Can be "text/plain", "text/html".
      @param object_id The ID of the object that is responsible for sending the mail in the first place
      @param extraheaders List of keywords and their values passed in for headers. Interesting ones are: "Precedence: list" to disable autoreplies and mark this as a list message. This is as list of lists !!
      @param single_email Boolean that indicates that only one mail will be send (in contrast to one e-mail per recipient).
      @param no_callback Boolean that indicates if callback should be executed or not. If you don't provide it it will execute callbacks
      @param single_email_p Boolean that indicates that only one mail will be send (in contrast to one e-mail per recipient). Used so we can set a variable in the callers environment to call complex_send.
      @param no_callback_p Boolean that indicates if callback should be executed or not. If you don't provide it it will execute callbacks. Used so we can set a variable in the callers environment to call complex_send.
      @param use_sender Boolean indicating that from_addr should be used regardless of fixed-sender parameter
      @param alternative_part_p Boolean whether or not the code generates a multipart/alternative mail (text/html)
      } {
      # check, if send_immediately is set
      # if not, take global parameter
      if {$send_immediately_p} {
      set send_p $send_immediately_p
      } else {
      # if parameter is not set, get the global setting
      set send_p [parameter::get -package_id [get_package_id] -parameter "send_immediately" -default 0]
      }
      # if send_p true, then start acs_mail_lite::send_immediately, so mail is not stored in the db before delivery
      if { $send_p } {
      acs_mail_lite::complex_send_immediately \
      -to_party_ids $to_party_ids \
      -cc_party_ids $cc_party_ids \
      -bcc_party_ids $bcc_party_ids \
      -to_group_ids $to_group_ids \
      -cc_group_ids $cc_group_ids \
      -bcc_group_ids $bcc_group_ids \
      -to_addr $to_addr \
      -cc_addr $cc_addr \
      -bcc_addr $bcc_addr \
      -from_addr $from_addr \
      -reply_to $reply_to \
      -subject $subject \
      -body $body \
      -package_id $package_id \
      -files $files \
      -file_ids $file_ids \
      -folder_ids $folder_ids \
      -mime_type $mime_type \
      -object_id $object_id \
      -single_email_p $single_email_p \
      -no_callback_p $no_callback_p \
      -extraheaders $extraheaders \
      -alternative_part_p $alternative_part_p \
      -use_sender_p $use_sender_p
      } else {
      # else, store it in the db and let the sweeper deliver the mail
      set creation_date [clock format [clock seconds] -format "%Y.%m.%d %H:%M:%S"]
      set locking_server ""
      db_dml create_complex_queue_entry {}
      }
      }
      #---------------------------------------
      # complex_send
      # created ... by ...
      # modified 2006/07/25 by nfl: new param. alternative_part_p
      # and creation of multipart/alternative
      # 2006/../.. Renamed to complex_send_immediately
      #---------------------------------------
      ad_proc -public complex_send_immediately {
      -valid_email:boolean
      {-to_party_ids ""}
      {-cc_party_ids ""}
      {-bcc_party_ids ""}
      {-to_group_ids ""}
      {-cc_group_ids ""}
      {-bcc_group_ids ""}
      {-to_addr ""}
      {-cc_addr ""}
      {-bcc_addr ""}
      -from_addr:required
      {-reply_to ""}
      {-subject ""}
      -body:required
      {-package_id ""}
      {-files ""}
      {-file_ids ""}
      {-folder_ids ""}
      {-mime_type "text/plain"}
      {-object_id ""}
      {-single_email_p ""}
      {-no_callback_p ""}
      {-extraheaders ""}
      {-alternative_part_p ""}
      {-use_sender_p ""}
      } {
      Prepare an email to be send immediately with the option to pass in a list
      of file_ids as well as specify an html_body and a mime_type. It also supports multiple "TO" recipients as well as CC
      and BCC recipients. Runs entirely off MIME and SMTP to achieve this.
      For backward compatibility a switch "single_email_p" is added.
      @param to_party_ids list of party ids to whom we send this email
      @param cc_party_ids list of party ids to whom we send this email in "CC"
      @param bcc_party_ids list of party ids to whom we send this email in "BCC"
      @param to_party_ids list of group_ids to whom we send this email
      @param cc_party_ids list of group_ids to whom we send this email in "CC"
      @param bcc_party_ids list of group_ids to whom we send this email in "BCC"
      @param to_addr List of e-mail addresses to send this mail to. We will figure out the name if possible.
      @param from_addr E-Mail address of the sender. We will try to figure out the name if possible.
      @param reply_to E-Mail address to which replies should go. Defaults to from_addr
      @param subject of the email
      @param body Text body of the email
      @param cc_addr List of CC Users e-mail addresses to send this mail to. We will figure out the name if possible. Only useful if single_email is provided. Otherwise the CC users will be send individual emails.
      @param bcc_addr List of CC Users e-mail addresses to send this mail to. We will figure out the name if possible. Only useful if single_email is provided. Otherwise the CC users will be send individual emails.
      @param package_id Package ID of the sending package
      @param files List of file_title, mime_type, file_path (as in full path to the file) combination of files to be attached
      @param folder_ids ID of the folder who's content will be send along with the e-mail.
      @param file_ids List of file ids (items or revisions) to be send as attachments. This will only work with files stored in the file system.
      @param mime_type MIME Type of the mail to send out. Can be "text/plain", "text/html".
      @param object_id The ID of the object that is responsible for sending the mail in the first place
      @param extraheaders List of keywords and their values passed in for headers. Interesting ones are: "Precedence: list" to disable autoreplies and mark this as a list message. This is as list of lists !!
      @param single_email Boolean that indicates that only one mail will be send (in contrast to one e-mail per recipient).
      @param no_callback Boolean that indicates if callback should be executed or not. If you don't provide it it will execute callbacks
      @param single_email_p Boolean that indicates that only one mail will be send (in contrast to one e-mail per recipient). Used so we can set a variable in the callers environment to call complex_send.
      @param no_callback_p Boolean that indicates if callback should be executed or not. If you don't provide it it will execute callbacks. Used so we can set a variable in the callers environment to call complex_send.
      @param use_sender Boolean indicating that from_addr should be used regardless of fixed-sender parameter
      @param alternative_part_p Boolean whether or not the code generates a multipart/alternative mail (text/html)
      } {
      set mail_package_id [apm_package_id_from_key "acs-mail-lite"]
      if {$package_id eq ""} {
      set package_id $mail_package_id
      }
      # We check if the parameter
      set fixed_sender [parameter::get -parameter "FixedSenderEmail" \
      -package_id $mail_package_id]
      if { $fixed_sender ne "" && !$use_sender_p} {
      set sender_addr $fixed_sender
      } else {
      set sender_addr $from_addr
      }
      # Get the SMTP Parameters
      set smtp [parameter::get -parameter "SMTPHost" \
      -package_id $mail_package_id -default [ns_config ns/parameters mailhost]]
      if {$smtp eq ""} {
      set smtp localhost
      }
      set timeout [parameter::get -parameter "SMTPTimeout" \
      -package_id $mail_package_id -default [ns_config ns/parameters smtptimeout]]
      if {$timeout eq ""} {
      set timeout 60
      }
      set smtpport [parameter::get -parameter "SMTPPort" \
      -package_id [apm_package_id_from_key "acs-mail-lite"] -default 25]
      set smtpuser [parameter::get -parameter "SMTPUser" \
      -package_id [apm_package_id_from_key "acs-mail-lite"]]
      set smtppassword [parameter::get -parameter "SMTPPassword" \
      -package_id [apm_package_id_from_key "acs-mail-lite"]]
      # default values for alternative_part_p
      # TRUE on mime_type text/html
      # FALSE on mime_type text/plain
      # if { $alternative_part_p eq "" } { ...}
      if { $alternative_part_p eq "" } {
      if { $mime_type eq "text/plain" } {
      set alternative_part_p "0"
      } else {
      set alternative_part_p "1"
      }
      }
      # Set the Reply-To
      if {$reply_to eq ""} {
      set reply_to $sender_addr
      }
      # Get the party_id for the sender
      set party_id($from_addr) [party::get_by_email -email $from_addr]
      # Deal with the sender address. Only change the from string if we find a party_id
      # This should take care of anyone parsing in an email which is already formated with <>.
      set party_id($sender_addr) [party::get_by_email -email $sender_addr]
      if {[exists_and_not_null party_id($sender_addr)]} {
      set from_string "\"[party::name -email $sender_addr]\" <${sender_addr}>"
      set reply_to_string "\"[party::name -email $sender_addr]\" <${reply_to}>"
      } else {
      set from_string $sender_addr
      set reply_to_string $sender_addr
      }
      # decision between normal or multipart/alternative body
      if { $alternative_part_p eq "0"} {
      # Set the message token
      set message_token [mime::initialize -canonical "$mime_type" -string "$body"]
      } else {
      # build multipart/alternative
      if { $mime_type eq "text/plain" } {
      set message_text_part [mime::initialize -canonical "text/plain" -string "$body"]
      set converted [ad_text_to_html "$body"]
      set message_html_part [mime::initialize -canonical "text/html" -string "$converted"]
      } else {
      set message_html_part [mime::initialize -canonical "text/html" -string "$body"]
      set converted [ad_html_to_text "$body"]
      set message_text_part [mime::initialize -canonical "text/plain" -string "$converted"]
      }
      set message_token [mime::initialize -canonical multipart/alternative -parts [list $message_text_part $message_html_part]]
      # see RFC 2046, 5.1.4. Alternative Subtype, for further information/reference (especially order of parts)
      }
      # encode all attachments in base64
      set tokens [list $message_token]
      set item_ids [list]
      if {[exists_and_not_null file_ids]} {
      # Check if we are dealing with revisions or items.
      foreach file_id $file_ids {
      set item_id [content::revision::item_id -revision_id $file_id]
      if {$item_id eq ""} {
      lappend item_ids $file_id
      } else {
      lappend item_ids $item_id
      }
      }
      db_foreach get_file_info "select r.mime_type,r.title, r.content as filename
      from cr_revisions r, cr_items i
      where r.revision_id = i.latest_revision
      and i.item_id in ([join $item_ids ","])" {
      lappend tokens [mime::initialize -param [list name "[ad_quotehtml $title]"] -header [list "Content-Disposition" "attachment; filename=$title"] -header [list Content-Description $title] -canonical $mime_type -file "[cr_fs_path]$filename"]
      }
      }
      # Append files from the filesystem
      if {$files ne ""} {
      foreach file $files {
      lappend tokens [mime::initialize -param [list name "[ad_quotehtml [lindex $file 0]]"] -canonical [lindex $file 1] -file "[lindex $file 2]"]
      }
      }
      # Append folders
      if {[exists_and_not_null folder_ids]} {
      foreach folder_id $folder_ids {
      db_foreach get_file_info {select r.revision_id,r.mime_type,r.title, i.item_id, r.content as filename
      from cr_revisions r, cr_items i
      where r.revision_id = i.latest_revision and i.parent_id = :folder_id} {
      lappend tokens [mime::initialize -param [list name "[ad_quotehtml $title]"] -canonical $mime_type -file "[cr_fs_path]$filename"]
      lappend item_ids $item_id
      }
      }
      }
      #### Now we start with composing the mail message ####
      set multi_token [mime::initialize -canonical multipart/mixed -parts "$tokens"]
      # Set the message_id
      set message_id "[mime::uniqueID]"
      mime::setheader $multi_token "message-id" "[mime::uniqueID]"
      # Set the date
      mime::setheader $multi_token date "[mime::parsedatetime -now proper]"
      # 2006/09/25 nfl/cognovis
      # subject: convert 8-bit characters into MIME encoded words
      # see http://tools.ietf.org/html/rfc2047
      #set subject_encoded [mime::word_encode "iso8859-1" base64 $subject]
      #regsub -all {\n} $subject_encoded {} subject_encoded
      #mime::setheader $multi_token Subject "$subject_encoded"
      mime::setheader $multi_token Subject "$subject"
      foreach header $extraheaders {
      mime::setheader $multi_token "[lindex $header 0]" "[lindex $header 1]"
      }
      set packaged [mime::buildmessage $multi_token]
      # Now the To recipients
      set to_list [list]
      foreach email $to_addr {
      set party_id($email) [party::get_by_email -email $email]
      if {$party_id($email) eq ""} {
      # We could not find a party_id, write the email alone
      lappend to_list $email
      } else {
      # Make sure we are not sending the same e-mail twice to the same person
      if {[lsearch $to_party_ids $party_id($email)] < 0} {
      lappend to_party_ids $party_id($email)
      }
      }
      }
      # Run through the party_ids and check if a group is in there.
      set new_to_party_ids [list]
      foreach to_id $to_party_ids {
      if {[group::group_p -group_id $to_id]} {
      lappend to_group_ids $to_id
      } else {
      if {[lsearch $new_to_party_ids $to_id] < 0} {
      lappend new_to_party_ids $to_id
      }
      }
      }
      foreach group_id $to_group_ids {
      foreach to_id [group::get_members -group_id $group_id] {
      if {[lsearch $new_to_party_ids $to_id] < 0} {
      lappend new_to_party_ids $to_id
      }
      }
      }
      # New to party ids contains now the unique party_ids of members of the groups along with the parties
      set to_party_ids $new_to_party_ids
      # Now the Cc recipients
      set cc_list [list]
      foreach email $cc_addr {
      set party_id($email) [party::get_by_email -email $email]
      if {$party_id($email) eq ""} {
      # We could not find a party_id, write the email alone
      lappend cc_list $email
      } else {
      # Make sure we are not sending the same e-mail twice to the same person
      if {[lsearch $cc_party_ids $party_id($email)] < 0} {
      lappend cc_party_ids $party_id($email)
      }
      }
      }
      # Run through the party_ids and check if a group is in there.
      set new_cc_party_ids [list]
      foreach cc_id $cc_party_ids {
      if {[group::group_p -group_id $cc_id]} {
      lappend cc_group_ids $cc_id
      } else {
      if {[lsearch $new_cc_party_ids $cc_id] < 0} {
      lappend new_cc_party_ids $cc_id
      }
      }
      }
      foreach group_id $cc_group_ids {
      foreach cc_id [group::get_members -group_id $group_id] {
      if {[lsearch $new_cc_party_ids $cc_id] < 0} {
      lappend new_cc_party_ids $cc_id
      }
      }
      }
      # New to party ids contains now the unique party_ids of members of the groups along with the parties
      set cc_party_ids $new_cc_party_ids
      # Now the Bcc recipients
      set bcc_list [list]
      foreach email $bcc_addr {
      set party_id($email) [party::get_by_email -email $email]
      if {$party_id($email) eq ""} {
      # We could not find a party_id, write the email alone
      lappend bcc_list $email
      } else {
      # Make sure we are not sending the same e-mail twice to the same person
      if {[lsearch $bcc_party_ids $party_id($email)] < 0} {
      lappend bcc_party_ids $party_id($email)
      }
      }
      }
      # Run through the party_ids and check if a group is in there.
      set new_bcc_party_ids [list]
      foreach bcc_id $bcc_party_ids {
      if {[group::group_p -group_id $bcc_id]} {
      lappend bcc_group_ids $bcc_id
      } else {
      if {[lsearch $new_bcc_party_ids $bcc_id] < 0} {
      lappend new_bcc_party_ids $bcc_id
      }
      }
      }
      foreach group_id $bcc_group_ids {
      foreach bcc_id [group::get_members -group_id $group_id] {
      if {[lsearch $new_bcc_party_ids $bcc_id] < 0} {
      lappend new_bcc_party_ids $bcc_id
      }
      }
      }
      # New to party ids contains now the unique party_ids of members of the groups along with the parties
      set bcc_party_ids $new_bcc_party_ids
      # Rollout support (see above for details)
      set delivery_mode [ns_config ns/server/[ns_info server]/acs/acs-rollout-support EmailDeliveryMode]
      if {$delivery_mode ne ""
      && $delivery_mode ne "default"
      } {
      set eh [util_list_to_ns_set $extraheaders]
      ns_sendmail $to_addr $sender_addr $subject $packaged $eh $bcc_addr
      #Close all mime tokens
      mime::finalize $multi_token -subordinates all
      } else {
      if {$single_email_p} {
      #############################
      #
      # One mail to all
      #
      #############################
      # First join the emails without parties for the callback.
      set to_addr_string [join $to_list ","]
      set cc_addr_string [join $cc_list ","]
      set bcc_addr_string [join $bcc_list ","]
      # Append the entries from the system users to the e-mail
      foreach party $to_party_ids {
      lappend to_list "\"[party::name -party_id $party]\" <[party::email_not_cached -party_id $party]>"
      }
      foreach party $cc_party_ids {
      lappend cc_list "\"[party::name -party_id $party]\" <[party::email_not_cached -party_id $party]>"
      }
      foreach party $bcc_party_ids {
      lappend bcc_list "\"[party::name -party_id $party]\" <[party::email_not_cached -party_id $party]>"
      }
      smtp::sendmessage $multi_token \
      -header [list From "$from_string"] \
      -header [list Reply-To "$reply_to_string"] \
      -header [list To "[join $to_list ","]"] \
      -header [list CC "[join $cc_list ","]"] \
      -header [list BCC "[join $bcc_list ","]"] \
      -servers $smtp \
      -ports $smtpport \
      -username $smtpuser \
      -password $smtppassword
      #Close all mime tokens
      mime::finalize $multi_token -subordinates all
      if { !$no_callback_p } {
      callback acs_mail_lite::complex_send \
      -package_id $package_id \
      -from_party_id [party::get_by_email -email $sender_addr] \
      -from_addr $sender_addr \
      -to_party_ids $to_party_ids \
      -cc_party_ids $cc_party_ids \
      -bcc_party_ids $bcc_party_ids \
      -to_addr $to_addr_string \
      -cc_addr $cc_addr_string \
      -bcc_addr $bcc_addr_string \
      -body $body \
      -message_id $message_id \
      -subject $subject \
      -object_id $object_id \
      -file_ids $item_ids
      }
      } else {
      ####################################################################
      #
      # Individual E-Mails.
      # All recipients, (regardless who they are) get a separate E-Mail
      #
      ####################################################################
      # We send individual e-mails. First the ones that do not have a party_id
      set recipient_list [concat $to_list $cc_list $bcc_list]
      foreach email $recipient_list {
      set message_id [mime::uniqueID]
      smtp::sendmessage $multi_token \
      -header [list From "$from_string"] \
      -header [list Reply-To "$reply_to_string"] \
      -header [list To "$email"] \
      -servers $smtp \
      -ports $smtpport \
      -username $smtpuser \
      -password $smtppassword
      if { !$no_callback_p } {
      callback acs_mail_lite::complex_send \
      -package_id $package_id \
      -from_party_id $party_id($from_addr) \
      -from_addr $from_addr \
      -to_addr $email \
      -body $body \
      -message_id $message_id \
      -subject $subject \
      -object_id $object_id \
      -file_ids $item_ids
      }
      }
      # And now we send it to all the other users who actually do have a party_id
      set recipient_list [concat $to_party_ids $cc_party_ids $bcc_party_ids]
      foreach party $recipient_list {
      set message_id [mime::uniqueID]
      set email "\"[party::name -party_id $party]\" <[party::email_not_cached -party_id $party]>"
      smtp::sendmessage $multi_token \
      -header [list From "$from_string"] \
      -header [list Reply-To "$reply_to_string"] \
      -header [list To "$email"] \
      -servers $smtp \
      -ports $smtpport \
      -username $smtpuser \
      -password $smtppassword
      if { !$no_callback_p } {
      callback acs_mail_lite::complex_send \
      -package_id $package_id \
      -from_party_id $party_id($from_addr) \
      -from_addr $from_addr \
      -to_party_ids $party \
      -body $body \
      -message_id $message_id \
      -subject $subject \
      -object_id $object_id \
      -file_ids $item_ids
      }
      }
      #Close all mime tokens
      mime::finalize $multi_token -subordinates all
      }
      }
      }
      #---------------------------------------
      # 2006/11/17 Created by cognovis/nfl
      # nsv_incr description: http://www.panoptic.com/wiki/aolserver/Nsv_incr
      #---------------------------------------
      ad_proc -private complex_sweeper {} {
      Send messages in the acs_mail_lite_complex_queue table.
      } {
      # Make sure that only one thread is processing the queue at a time.
      if {[nsv_incr acs_mail_lite complex_send_mails_p] > 1} {
      nsv_incr acs_mail_lite complex_send_mails_p -1
      return
      }
      with_finally -code {
      db_foreach get_complex_queued_messages {} {
      # check if record is already there and free to use
      set return_id [db_string get_complex_queued_message {} -default -1]
      if {$return_id == $id} {
      # lock this record for exclusive use
      set locking_server [ad_url]
      db_dml lock_queued_message {}
      # send the mail
      set err [catch {
      acs_mail_lite::complex_send_immediately \
      -to_party_ids $to_party_ids \
      -cc_party_ids $cc_party_ids \
      -bcc_party_ids $bcc_party_ids \
      -to_group_ids $to_group_ids \
      -cc_group_ids $cc_group_ids \
      -bcc_group_ids $bcc_group_ids \
      -to_addr $to_addr \
      -cc_addr $cc_addr \
      -bcc_addr $bcc_addr \
      -from_addr $from_addr \
      -reply_to $reply_to \
      -subject $subject \
      -body $body \
      -package_id $package_id \
      -files $files \
      -file_ids $file_ids \
      -folder_ids $folder_ids \
      -mime_type $mime_type \
      -object_id $object_id \
      -single_email_p $single_email_p \
      -no_callback_p $no_callback_p \
      -extraheaders $extraheaders \
      -alternative_part_p $alternative_part_p \
      -use_sender_p $use_sender_p
      } errMsg]
      if {$err} {
      ns_log Error "Error while sending queued complex mail: $errMsg"
      # release the lock
      set locking_server ""
      db_dml lock_queued_message {}
      } else {
      # mail was sent, delete the queue entry
      db_dml delete_complex_queue_entry {}
      }
      }
      }
      } -finally {
      nsv_incr acs_mail_lite complex_send_mails_p -1
      }
      }
      }
      tcl/complex-send-procs.xql 0 → 100644
      View file @ d7e69903
      <?xml version="1.0"?>
      <queryset>
      <fullquery name="acs_mail_lite::complex_sweeper.get_complex_queued_message">
      <querytext>
      select id
      from acs_mail_lite_complex_queue
      where id=:id and (locking_server = '' or locking_server is NULL)
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::complex_sweeper.lock_queued_message">
      <querytext>
      update acs_mail_lite_complex_queue
      set locking_server = :locking_server
      where id=:id
      </querytext>
      </fullquery>
      <fullquery name="acs_mail_lite::complex_sweeper.delete_complex_queue_entry">
      <querytext>
      delete from acs_mail_lite_complex_queue
      where id=:id
      </querytext>
      </fullquery>
      </queryset>
      tcl/incoming-mail-procs.tcl 0 → 100644
      View file @ d7e69903
      ad_library {
      Provides a simple API for reliably sending email.
      @author Eric Lorenzo (eric@openforce.net)
      @creation-date 22 March 2002
      @cvs-id $Id$
      }
      package require mime 1.4
      package require smtp 1.4
      package require base64 2.3.1
      namespace eval acs_mail_lite {
      #---------------------------------------
      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 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 {}
      # This will parse the E-mail and extract the files to the file system
      parse_email -file $msg -array email
      set email(to) [parse_email_address -email $email(to)]
      set email(from) [parse_email_address -email $email(from)]
      set subject [lindex $email(subject) 0]
      if {$email(bodies) eq ""} {
      ad_script_abort
      ns_log Notice "E-Mail without body"
      }
      # Do no execute any callbacks if the email is an autoreply.
      # Thanks to Vinod for the idea and the code
      set callback_executed_p [acs_mail_lite::autoreply_p -subject $subject -from $email(from)]
      if {!$callback_executed_p} {
      # Special treatment for e-mails which look like they contain an object_id
      set pot_object_id [lindex [split $email(to) "@"] 0]
      if {[ad_var_type_check_number_p $pot_object_id]} {
      if {[acs_object::object_p -id $pot_object_id]} {
      callback acs_mail_lite::incoming_object_email -array email -object_id $pot_object_id
      # Mark that the callback has been executed already
      set no_callback_p 1
      }
      }
      }
      if {!$callback_executed_p} {
      # 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}] || [mime::getheader $part Content-disposition] eq "inline"} {
      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]
      array set param $params
      # Append the file if there exist a filename to use. Otherwise do not append
      if {[exists_and_not_null param(name)]} {
      set filename $param(name)
      # 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 autoreply_p {
      {-subject ""}
      {-from ""}
      } {
      Parse the subject, from and body to determin if the email is an auto reply
      Typical autoreplies are "Out of office" messages. This is what the procedure does
      @param subject Subject of the Email that will be scanned for "out of office"
      @param from From address which will be checked if it is coming from a mailer daemon
      @return 1 if this is actually an autoreply
      } {
      set autoreply_p 0
      if {$subject ne ""} {
      # check subject
      set autoreply_p [regexp -nocase "(out of.*office|automated response|autoreply)" $subject]
      set autoreply_p [regexp "NDN" $subject]
      set autoreply_p [regexp "\[QuickML\] Error" $subject]
      }
      if {$from ne ""} {
      # check from if it comes from the mailer daemon
      set autoreply_p [regexp -nocase "mailer.*daemon" $from]
      }
      return $autoreply_p
      }
      }
      \ No newline at end of file
      www/restore-bounce.adp 0 → 100644
      View file @ d7e69903
      <master>
      <property name="title">@page_title;noquote@</property>
      <property name="context">@context;noquote@</property>
      <p>#acs-mail-lite.Bounce_disabled#</p>
      <p>
      <b>&raquo;</b> <a href="@return_url@">#acs-subsite.Continue#</a>
      </p>
      www/restore-bounce.tcl 0 → 100644
      View file @ d7e69903
      ad_page_contract {
      The page restores a user from the deleted state.
      @cvs-id $Id$
      } {
      {return_url {[ad_pvt_home]}}
      }
      set page_title [_ acs-mail-lite.Restore_bounce]
      set context [list [list [ad_pvt_home] [ad_pvt_home_name]] $page_title]
      # We do require authentication, though their account will be closed
      set user_id [auth::require_login]
      db_dml unbounce_user "update users set email_bouncing_p = 'f' where user_id = :user_id"
      # Used in a message key
      set system_name [ad_system_name]
      Markdown is supported
      0% or
      You are about to add 0 people to the discussion. Proceed with caution.
      Finish editing this message first!
      Please register or to comment