acs_mail_lite::imap_check_incoming (private)

 acs_mail_lite::imap_check_incoming

Defined in packages/acs-mail-lite/tcl/imap-inbound-procs.tcl

Checks for new, actionable incoming email via imap connection. Email is actionable if it is identified by acs_mail_lite::email_type. When actionable, email is buffered in table acs_mail_lite_from_external and callbacks are triggered.

See Also:

Partial Call Graph (max 5 caller/called nodes):
%3 acs_mail_lite::email_type acs_mail_lite::email_type (public) acs_mail_lite::imap_conn_close acs_mail_lite::imap_conn_close (public) acs_mail_lite::imap_conn_go acs_mail_lite::imap_conn_go (private) acs_mail_lite::imap_conn_set acs_mail_lite::imap_conn_set (private) acs_mail_lite::imap_email_parse acs_mail_lite::imap_email_parse (private) acs_mail_lite::imap_check_incoming acs_mail_lite::imap_check_incoming acs_mail_lite::imap_check_incoming->acs_mail_lite::email_type acs_mail_lite::imap_check_incoming->acs_mail_lite::imap_conn_close acs_mail_lite::imap_check_incoming->acs_mail_lite::imap_conn_go acs_mail_lite::imap_check_incoming->acs_mail_lite::imap_conn_set acs_mail_lite::imap_check_incoming->acs_mail_lite::imap_email_parse

Testcases:
No testcase defined.
Source code:
    set error_p 0
    if { [nsv_exists acs_mail_lite si_configured_p ] } {
        set si_configured_p [nsv_get acs_mail_lite si_configured_p]
    } else {
        set si_configured_p 1
        # Try to connect at least once
    }
    # This proc is called by ad_schedule_proc regularly

    # scan_in_ = scan_in_est_ = scan_in_estimate = si_
    if { $si_configured_p } {
        set cycle_start_cs [clock seconds]
        nsv_lappend acs_mail_lite si_actives_list $cycle_start_cs
        set si_actives_list [nsv_get acs_mail_lite si_actives_list]

        set si_dur_per_cycle_s  [nsv_get acs_mail_lite si_dur_per_cycle_s]
        set per_cycle_s_override [nsv_get acs_mail_lite  si_dur_per_cycle_s_override]
        set si_quit_cs  [expr { $cycle_start_cs + int( $si_dur_per_cycle_s * .8 )}]
        if { $per_cycle_s_override ne "" } {
            set si_quit_cs [expr { $si_quit_cs - $per_cycle_s_override } ]
            # deplayed
        } else {
            set per_cycle_s_override $si_dur_per_cycle_s
        }


        set active_cs [lindex $si_actives_list end]
        set concurrent_ct [llength $si_actives_list]
        # pause is in seconds
        set pause_s 10
        set pause_ms [expr { $pause_s * 1000 } ]
        while { $active_cs eq $cycle_start_cs
                && [clock seconds] < $si_quit_cs
                && $concurrent_ct > 1
            } {
            incr per_cycle_s_override $pause_s
            nsv_set acs_mail_lite si_dur_per_cycle_s_override  $per_cycle_s_override
            set si_actives_list [nsv_get acs_mail_lite si_actives_list]
            set active_cs [lindex $si_actives_list end]
            set concurrent_ct [llength $si_actives_list]
            ns_log Notice "acs_mail_lite::imap_check_incoming.1198.  pausing ${pause_s} seconds for prior invoked processes to stop.  si_actives_list '${si_actives_list}'"
            after $pause_ms
        }

        if { [clock seconds] < $si_quit_cs
             && $active_cs eq $cycle_start_cs
         } {
            set cid [acs_mail_lite::imap_conn_go ]
            if { $cid eq "" } {
                set error_p 1
            }

            if { !$error_p } {

                array set conn_arr [acs_mail_lite::imap_conn_set]
                unset conn_arr(password)
                set mailbox_host_name "{{"
                append mailbox_host_name $conn_arr(host) "}"  $conn_arr(name_mb) "}"

                set status_list [ns_imap status $cid]
                if { ![f::even_p [llength $status_list]] } {
                    lappend status_list ""
                }
                array set status_arr $status_list
                set uidvalidity $status_arr(Uidvalidity)
                if { [info exists status_arr(Uidnext)]
                     && [info exists status_arr(Messages)]
                 } {
                    set aml_package_id [apm_package_id_from_key "acs-mail-lite"]
                    set filter_proc [parameter::get -parameter "IncomingFilterProcName"  -package_id $aml_package_id]
                    #
                    # Iterate through emails
                    #
                    # ns_imap search should be faster than ns_imap sort
                    set m_list [ns_imap search $cid ""]

                    foreach msgno $m_list {
                        set struct_list [ns_imap struct $cid $msgno]

                        # add struct info to headers for use with ::email_type
                        # headers_arr = hdrs_arr
                        array set hdrs_arr $struct_list
                        set uid $hdrs_arr(uid)

                        set processed_p [acs_mail_lite::inbound_cache_hit_p  $uid  $uidvalidity  $mailbox_host_name ]

                        if { !$processed_p } {
                            set headers_list [ns_imap headers $cid $msgno]
                            array set hdrs_arr $headers_list

                            set type [acs_mail_lite::email_type  -header_arr_name hdrs_arr ]


                            # Create some standardized header indexes aml_*
                            # with corresponding values
                            set size_idx [lsearch -nocase -exact  $headers_list size]
                            set sizen [lindex $headers_list $size_idx]
                            if { $sizen ne "" } {
                                set hdrs_arr(aml_size_chars) $hdrs_arr(${sizen})
                            } else {
                                set hdrs_arr(aml_size_chars) ""
                            }

                            if { [info exists hdrs_arr(received_cs)] } {
                                set hdrs_arr(aml_received_cs) $hdrs_arr(received_cs)
                            } else {
                                set hdrs_arr(aml_received_cs) ""
                            }

                            set su_idx [lsearch -nocase -exact  $headers_list subject]
                            if { $su_idx > -1 } {
                                set sun [lindex $headers_list $su_idx]
                                set hdrs_arr(aml_subject) [ns_quotehtml $hdrs_arr(${sun})]
                            } else {
                                set hdrs_arr(aml_subject) ""
                            }

                            set to_idx [lsearch -nocase -exact  $headers_list to]
                            if { ${to_idx} > -1 } {
                                set ton [lindex $headers_list $to_idx]
                                set hdrs_arr(aml_to) [ns_quotehtml $hdrs_arr(${ton}) ]
                            } else {
                                set hdrs_arr(aml_to) ""
                            }

                            acs_mail_lite::inbound_email_context  -header_array_name hdrs_arr  -header_name_list $headers_list

                            acs_mail_lite::inbound_prioritize  -header_array_name hdrs_arr

                            set error_p [acs_mail_lite::imap_email_parse  -headers_arr_name hdrs_arr  -parts_arr_name parts_arr  -conn_id $cid  -msgno $msgno  -struct_list $struct_list]

                            if { !$error_p && [string match {[a-z]*_[a-z]*} $filter_proc] } {
                                set hdrs_arr(aml_package_ids_list) [ad_safe_eval ${filter_proc}]
                            }
                            if { !$error_p } {

                                set id [acs_mail_lite::inbound_queue_insert  -parts_arr_name parts_arr
                                         -headers_arr_name hdrs_arr  -error_p $error_p ]
                                ns_log Notice "acs_mail_lite::imap_check_incoming  inserted to queue aml_email_id '${id}'"
                            }

                        }
                    }
                } else {
                    ns_log Warning "acs_mail_lite::imap_check_incoming.1274.  Unable to process email.  Either Uidnext or Messages not in status_list: '${status_list}'"
                }

                if { [clock seconds] + 65 < $si_quit_cs } {
                    # Regardless of parameter SMTPTimeout,
                    # if there is more than 65 seconds to next cycle,
                    # close connection
                    acs_mail_lite::imap_conn_close -conn_id $cid
                }

            }
            # end if !$error

            # remove active_cs from si_actives_list
            set si_idx [lsearch -integer -exact $si_actives_list $active_cs]
            # We call nsv_get within nsv_set to reduce chances of dropping
            # a new list entry.
            nsv_set acs_mail_lite si_actives_list  [lreplace  [nsv_get acs_mail_lite si_actives_list] $si_idx $si_idx]

        } else {
            nsv_set acs_mail_lite si_configured_p 0
        }
        # acs_mail_lite::imap_check_incoming should quit gracefully
        # when not configured or there is error on connect.

    }
    return $si_configured_p
XQL Not present:
Generic, PostgreSQL, Oracle
[ hide source ] | [ make this the default ]
Show another procedure: