Все блоги / Разное

Приёмник для Алертов

10 февраля 2025, 08:22

Maxim Kuznetsov

Небольшой tcl скрипт, принимающий алерты от разных терминалов

Запускается на локальном хосте и принимает алерты от локальных-же терминалов.

Так как они все на одной машине, то работает всё практичсеки моментально.

Пока просто печатает в окошко,

но можете внести правки в процедуру deliverMIME

и выполнять чего хотите - запускать программы, перенаправлять дальше, включать сирены и так далее

как видите, работает не только с MetaTrader :-)

настройки самих терминалов донельзя простые :

И сам по себе скрипт:

##
## принимаем алерты по локальной почте 
##

# используется слегка патченный smtpd
lappend auth_path [ file join [ pwd ] lib ]

# 
package require Tk
package require smtpd 1.6
package require pop3d
package require mime
package require base64
#package require tls
#tls::init -tls1 1

## по умолчанию - просто печатаем в текст
wm title . "Mail Alert Recipient"
frame           .view
text            .view.text -yscrollcommand [ list .view.vscroll set ] -xscrollcommand [ list .view.vscroll set ]
scrollbar       .view.vscroll -orient vert -command [ list .view.text yview ]
scrollbar       .view.hscroll -orient hor  -command [ list .view.text xview ]
grid .view.text -row 0 -column 0 -sticky "nsew"
grid .view.vscroll -row 0 -column 1 -sticky "ns" 
grid .view.hscroll -row 1 -column 0 -sticky "ew"
grid rowconfigure .view 0 -weight 1
grid columnconfigure .view 0 -weight 1

grid .view -row 0 -column 0 -sticky "nsew"
grid rowconfigure . 0 -weight 1
grid columnconfigure . 0 -weight 1

proc print { args } {
        .view.text insert end [ join $args " " ]
        .view.text insert end \n
        .view.text see end
}

# конфигурация smtpd - просто указываем процедуры

smtpd::configure \
        -validate_host validate_host \
        -validate_sender validate_sender \
        -validate_recipient validate_recipient \
        -deliverMIME deliverMIME

proc validate_host { ipnum } {
        print "validate_host $ipnum"
        if { $ipnum != "127.0.0.1" } {
                print "host denied"
                error "access denied"
        }
}
proc validate_sender { address } {
        print "validate_sender $address"
        array set addr {*}[mime::parseaddress $address]
        if { [ string match "denied" $addr(local) ] } {
                print "address denied"
                error "mailbox $addr(local) denied"
        }
}
proc validate_recipient { address } {
        print "validate_rcpt $address"
}
proc deliverMIME { token } {
        print "deliverMIME $token"
        set time [ clock seconds ]
        set sender [ lindex [ mime::getheader $token "From" ] 0 ]
        set recipients [ lindex [ mime::getheader $token "To" ] 0 ] 
        set subject [ lindex [ mime::getheader $token "Subject" ] 0 ]
        set encoding [ lindex [ mime::getheader $token "Content-Type" ] 0 ]
        
        # всё в текстовом виде
        #set text [ mime::buildmessage $token ]
        # или по частям:
        set text [ mime::getbody $token -decode ]
        print "---[ clock format $time -format "%T" ]---"
        print "From $sender"
        print "To [join $recipients ,]"
        print "Subject $subject"
        print $text
}

# pop3d иногда нужен чтобы принимать аутенфикацию
# редко, но некоторые по старинке так работают
pop3d::new popserv 
popserv configure -auth pop3_auth
#popserv configure -socket [ list tls::socket -autoservername true ]
proc pop3_auth { cmd name } {
        print "pop3 $cmd $name"
        switch $cmd {
                "exists" {
                        # проверка существования пользователя name
                        # считаем что все есть
                        return true
                } "lookup" {
                        # логин 
                        return [ list $name "123" ]
                }
        }
}       
# запускаем
print "start pop3d"
popserv up
print "start smtpd"
smtpd::start 127.0.0.1 25