123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328 |
- #!/usr/bin/wish
- tk scaling 1.2
- set serverAddress "ip"
- set serverPort "25"
- set mailFrom "user@server.domain"
- set mailRecipient "user2@server.domain"
- set mailSubject "subj"
- proc sendSmtpRequest { smtpRequest } {
- puts $::serverSocket $smtpRequest
- flush $::serverSocket
- }
- proc unexpectedDataReceiver { } {
-
- if { [eof $::serverSocket] } {
- puts "============================================================="
- disconnectFromSmtpServer
- return
- }
-
- puts [ gets $::serverSocket ]
-
- incr ::unexpectedPacketNo
- if { $::unexpectedPacketNo > 9 } {
- puts "============================================================="
- disconnectFromSmtpServer
- }
- }
- proc unexpectedPacketHandler { msg } {
-
- puts "Fatal protocol error. Send mail state is $::sendMailStep."
- puts "Undefined data from server:"
- puts "============================================================="
- puts "$msg"
-
- incr ::sendMailErrorFlag
- set ::unexpectedPacketNo 0
- set ::sendMailStep "error"
- fileevent $::serverSocket readable unexpectedDataReceiver
- }
- proc unexpectedSmtpCodeHandler { expectedCode } {
-
- incr ::sendMailErrorFlag
- puts "SMTP code is $::smtpCode, but uxpected $expectedCode"
- puts "msg $::smtpCodeDescription"
- puts "Step is $::sendMailStep"
- puts "Quiting..."
- sendSmtp_QUIT
- }
- proc sendSmtp_HELO { } {
-
- if { $::smtpCode != 220 } {
- unexpectedSmtpCodeHandler 220
- return
- }
-
- sendSmtpRequest "HELO $::mailFromDomain"
- set ::sendMailStep "HELO"
- set ::sendMailProgress 30
- }
- proc sendSmtp_MAIL_FROM { } {
-
- if { $::smtpCode != 250 } {
- unexpectedSmtpCodeHandler 250
- return
- }
-
- sendSmtpRequest "MAIL FROM: <$::mailFrom>"
- set ::sendMailStep "MAIL_FROM"
- set ::sendMailProgress 40
- }
- proc sendSmtp_RCPT_TO { } {
-
- if { $::smtpCode != 250 } {
- unexpectedSmtpCodeHandler 250
- return
- }
-
- sendSmtpRequest "RCPT TO: <$::mailRecipient>"
- set ::sendMailStep "RCPT_TO"
- set ::sendMailProgress 50
- }
- proc sendSmtp_DATA { } {
-
- if { $::smtpCode != 250 } {
- unexpectedSmtpCodeHandler 250
- return
- }
-
- sendSmtpRequest "DATA"
- set ::sendMailStep "DATA"
- set ::sendMailProgress 60
- }
- proc sendSmtp_mail_body { } {
-
- if { $::smtpCode != 354 } {
- unexpectedSmtpCodeHandler 354
- return
- }
-
- set currentDate [ clock format [clock seconds] -format "%a, %d %b %Y %H:%M:%S %z" ]
-
- #mail headers
- puts $::serverSocket "From: <$::mailFrom>"
- puts $::serverSocket "To: <$::mailRecipient>"
- puts $::serverSocket "Subject: $::mailSubject"
- puts $::serverSocket "Date: $currentDate"
- puts $::serverSocket "MIME-Version: 1.0"
- puts $::serverSocket "Content-Transfer-Encoding: 8bit"
- puts $::serverSocket "Content-Type: text/plain; charset=\"UTF-8\""
- puts $::serverSocket ""
- flush $::serverSocket
-
- #mail text
- puts $::serverSocket "$::mailText"
- flush $::serverSocket
-
- #mail text terminator
- puts -nonewline $::serverSocket "\n.\n"
- flush $::serverSocket
-
- set ::sendMailStep "mail_body"
- set ::sendMailProgress 70
- }
- proc sendSmtp_QUIT { } {
-
- if { $::smtpCode != 250 } {
- puts "It looks like something went wrong. Code is $::smtpCode."
- puts "msg $::smtpCodeDescription"
- }
-
- sendSmtpRequest "QUIT"
- set ::sendMailStep "QUIT"
- set ::sendMailProgress 90
- }
- proc sendSmtp_disconnect { } {
-
- if { $::smtpCode != 221 } {
- puts "Warning: unexpected response code on QUIT command."
- puts "Code is $::smtpCode, expected 221"
- puts "msg $::smtpCodeDescription"
- }
-
- disconnectFromSmtpServer
- }
- proc smtpCodeParser { msg } {
-
- #normal
- set matchCount [ regexp {^([0-9]{3})([ -]{1})(.+)$} $msg fullMatch ::smtpCode ::smtpCodeMultiline ::smtpCodeDescription ]
-
- if { $matchCount == 1 } { return }
-
- #only code
- set matchCount [ regexp {^[0-9]{3}} $msg ::smtpCode ]
-
- if { $matchCount == 1 } {
-
- set ::smtpCodeDescription ""
- set ::smtpCodeMultiline " "
- puts "Warning: the received packet does not fully comply with the RFC!"
- return
- }
-
- unexpectedPacketHandler $msg
-
- }
- proc sendMail { } {
-
- if { [ eof $::serverSocket ] } {
- puts "Unexpected disconnection from server!"
- disconnectFromSmtpServer
- return
- }
-
- set buf [ gets $::serverSocket ]
- smtpCodeParser $buf
-
- switch $::sendMailStep {
-
- "connected" { sendSmtp_HELO }
- "HELO" { sendSmtp_MAIL_FROM }
- "MAIL_FROM" { sendSmtp_RCPT_TO }
- "RCPT_TO" { sendSmtp_DATA }
- "DATA" { sendSmtp_mail_body }
- "mail_body" { sendSmtp_QUIT }
- "QUIT" { sendSmtp_disconnect }
-
- default { }
- }
- }
- proc prepareMail { } {
-
- set matchCount [ regexp -- "^.+@(.+)$" $::mailFrom fullMatch ::mailFromDomain ]
-
- if { $matchCount != 1 } {
- throw "error" "e-mail address invalid"
- }
-
- set ::mailText [ .tabs.writer.entry get 0.0 end ]
- }
- proc connect2SmtpServer { } {
-
- set ::sendMailErrorFlag 0
- set ::sendMailProgress 0
- set ::sendMailStatus ""
-
- prepareMail
-
- set ::serverSocket [ socket $::serverAddress $::serverPort ]
- puts "Connected to $::serverAddress:$::serverPort"
- fileevent $::serverSocket readable sendMail
-
- set ::sendMailStep "connected"
- set ::sendMailProgress 15
- set ::sendMailStatus "Processing..."
- }
- proc disconnectFromSmtpServer { } {
-
- close $::serverSocket
- puts "Disconnected from $::serverAddress:$::serverPort"
- set ::sendMailStep "disconnected"
- set ::sendMailProgress 100
-
- if { $::sendMailErrorFlag > 0 } {
- set ::sendMailStatus "Failed."
- } else {
- set ::sendMailStatus "Done."
- }
- }
- proc buildMainGui { } {
-
- ### TABS ###
- ttk::notebook .tabs
- grid .tabs -padx 5 -pady 5
-
- ttk::frame .tabs.requisites
- ttk::frame .tabs.writer
- ttk::frame .tabs.attachments
- ttk::frame .tabs.send
-
- .tabs add .tabs.requisites -text "Requisites"
- .tabs add .tabs.writer -text "Message"
- .tabs add .tabs.attachments -text "Attachments"
- .tabs add .tabs.send -text "Send"
-
-
- ### REQUISITES TAB ###
- label .tabs.requisites.fromLabel -anchor e -text "From:"
- label .tabs.requisites.toLabel -anchor e -text "To:"
- label .tabs.requisites.subjectLabel -anchor e -text "Subject:"
- ttk::entry .tabs.requisites.fromEntry -textvariable mailFrom
- ttk::entry .tabs.requisites.toEntry -textvariable mailRecipient
- ttk::entry .tabs.requisites.subjectEntry -textvariable mailSubject
- grid .tabs.requisites.fromLabel -sticky we -padx 5
- grid .tabs.requisites.toLabel -sticky we -padx 5
- grid .tabs.requisites.subjectLabel -sticky we -padx 5
- grid .tabs.requisites.fromEntry -row 0 -column 1 -sticky we -padx 5 -pady 5
- grid .tabs.requisites.toEntry -row 1 -column 1 -sticky we -padx 5 -pady 5
- grid .tabs.requisites.subjectEntry -row 2 -column 1 -sticky we -padx 5 -pady 5
-
- grid columnconfigure .tabs.requisites 1 -weight 1
-
-
- ### WRITER TAB ###
- text .tabs.writer.entry -yscrollcommand ".tabs.writer.scrollV set" -xscrollcommand ".tabs.writer.scrollH set"
- ttk::scrollbar .tabs.writer.scrollV -orient vertical -command ".tabs.writer.entry yview"
- ttk::scrollbar .tabs.writer.scrollH -orient horizontal -command ".tabs.writer.entry xview"
-
- grid .tabs.writer.entry -row 0 -column 0
- grid .tabs.writer.scrollV -row 0 -column 1 -sticky ns
- grid .tabs.writer.scrollH -row 1 -column 0 -sticky we
-
-
- ### SEND TAB ###
- label .tabs.send.addressLabel -text "SMTP server:"
- ttk::entry .tabs.send.address -textvariable serverAddress
- ttk::entry .tabs.send.port -textvariable serverPort
- button .tabs.send.button -text "Send" -command connect2SmtpServer
- ttk::progressbar .tabs.send.progress -variable sendMailProgress
- ttk::button .tabs.send.cancel -text "Cancel" -command disconnectFromSmtpServer
- label .tabs.send.status -textvariable sendMailStatus
-
- grid .tabs.send.addressLabel -row 0 -column 0
- grid .tabs.send.address -row 0 -column 1
- grid .tabs.send.port -row 0 -column 2
- grid .tabs.send.button -row 1 -column 0
- grid .tabs.send.progress -row 1 -column 1
- grid .tabs.send.cancel -row 1 -column 2
- grid .tabs.send.status -row 2 -column 1
-
- #grid rowconfigure .tabs.send 0 -weight 1
- grid rowconfigure .tabs.send 1 -weight 1
- grid columnconfigure .tabs.send 0 -weight 1
- grid columnconfigure .tabs.send 1 -weight 1
-
-
- ### DEBUG ###
- ttk::button .debugButton -text "Debug" -command debugFunction
- grid .debugButton
-
- }
- bind . <Control-q> { destroy . }
- buildMainGui
|