BBS水木清华站∶精华区

发信人: Mephis.bbs@bbs.ee.ncu.edu.tw (梅菲斯特), 看板: Linux
标  题: simple finger/pop3 TCL/TK client
发信站: 中央大学松涛风情资讯站 (Sun Jan 19 09:18:27 1997)
转信站: sobee!netnews.ntu!linux2.tpml!UUserv.Net.tw!aidebbs!spring!News.csie.n

花一个早上用 TCL/TK 写的, 希望对网友有帮助 :)
BTW, 若堪使用, 烦请用 e-mail 告知你的 plateform tks

#!/bin/sh
# the next line restarts using wish \
exec wish4.2 "$0" "$@"

proc fingerWrit {} {
        global finger_sock

        fileevent $finger_sock writable {}
        flush $finger_sock
}

proc fingerSend {message} {
        global finger_sock

        fileevent $finger_sock writable fingerWrit
        puts $finger_sock $message
}

proc fingerRead {} {
        global finger_sock

        if { [gets $finger_sock finger_buff] < 0 } {
                close $finger_sock
                return
        }
        puts $finger_buff
}

proc fingerOpen {} {
        global hostname portname username
        global finger_sock
        if {[catch {socket $hostname $portname} finger_sock]!=0} {
                tk_dialog .errorMsg "ERROR MESSAGE" $finger_sock question 0 OK
                return
        }
        # fconfigure $sd -blocking false
        # puts "After socket command"

        fileevent $finger_sock readable fingerRead
        fingerSend $username
}

proc pop3Error {} {
        global pop3_sock pop3_buff

        tk_dialog .errorMsg "ERROR MESSAGE" $pop3_buff info 0 OK
        fileevent $pop3_sock readable {}
        close $pop3_sock
}

proc pop3Writ {} {
        global pop3_sock

        fileevent $pop3_sock writable {}
        flush $pop3_sock
}

proc pop3Send {message} {
        global pop3_sock

        fileevent $pop3_sock writable pop3Writ
        puts $pop3_sock $message
}

proc pop3Read {} {
        global username password
        global pop3_sock pop3_stat pop3_list pop3_line pop3_buff
        global pop3_mail pop3_retr
        if { [gets $pop3_sock pop3_buff] < 0 } {
                # puts "REACH EOF"
                close $pop3_sock
                return
        }
        if [string compare $pop3_stat retr_context] {
                puts $pop3_buff
        } else {
                incr pop3_line
                puts [format "%d:%s$" $pop3_line $pop3_buff]
        }

        switch $pop3_stat {
                send_user {
                        if [string compare [lindex $pop3_buff 0] "+OK"] {
                                pop3Error
                                return
                        }
                        pop3Send "USER $username"
                        set pop3_stat send_pass
                }
                send_pass {
                        if [string compare [lindex $pop3_buff 0] "+OK"] {
                                pop3Error
                                return
                        }
                        pop3Send "PASS $password"
                        set pop3_stat login_ok
                }
                login_ok {
                        if [string compare [lindex $pop3_buff 0] "+OK"] {
                                pop3Error
                                return
                        }
                        set pop3_mail [lindex $pop3_buff 1]
                        set pop3_retr 1
                        if {$pop3_retr > $pop3_mail} {
                                pop3Send "QUIT"
                                set pop3_stat quit_result
                                return
                        }
                        pop3Send "RETR $pop3_retr"
                        set pop3_stat retr_result
                }
                retr_result {
                        if [string compare [lindex $pop3_buff 0] "+OK"] {
                                pop3Error
                                return
                        }
                        set pop3_stat retr_context
                        set pop3_line 0
                }
                retr_context {
                        if {[string compare $pop3_buff "."] != 0} {
                                # puts "NOT EOF"
                                return
                        }
                        incr pop3_retr
                        if {$pop3_retr > $pop3_mail} {
                                pop3Send "QUIT"
                                set pop3_stat quit_result
                                return
                        }
                        pop3Send "RETR $pop3_retr"
                        set pop3_stat retr_result
                }
                quit_resut {
                        if [string compare [lindex $pop3_buff 0] "+OK"] {
                                pop3Error
                                return
                        }
                }
                default        {}
        }
}

proc pop3Open {} {
        global hostname portname username password
        global pop3_sock pop3_stat pop3_list pop3_line
        if {[catch {socket $hostname $portname} pop3_sock]!=0} {
                tk_dialog .errorMsg "ERROR MESSAGE" $pop3_sock question 0 OK
                return
        }
        # puts "After socket command"
        # fconfigure $pop3_sock -blocking false

        set pop3_stat send_user
        set pop3_list 0
        set pop3_line 0
        fileevent $pop3_sock readable "pop3Read"
}

frame .buttons -bd 2

button .buttons.fingerOpen -font 10x20 -text fingerOpen        \
        -command {
                set portname "finger"
                fingerOpen
        }
pack .buttons.fingerOpen -side left -expand 1

button .buttons.pop3Open -font 10x20 -text pop3Open \
        -command {
                set portname "pop-3"
                pop3Open
        }
pack .buttons.pop3Open -side left -expand 1

pack .buttons -side bottom -fill x -pady 2m

foreach i {.f1 .f2 .f3} {
        frame $i -bd 2
        label $i.label -font 10x20
        entry $i.entry -font 10x20 -width 32 -relief sunken
        bind $i.entry <Return> {
                if {[string compare $portname "pop-3"] == 0} {
                        pop3Open
                } else {
                        set portname "finger"
                        fingerOpen
                }
        }
        pack $i.label -side left
        pack $i.entry -side right
}

..f1.label configure -text "Host:"
..f1.entry configure -textvariable hostname
set hostname bbs.ntu.edu.tw

# .f2.label configure -text "Port:"
# .f2.entry configure -textvariable portname
set portname finger

..f2.label configure -text "User:"
..f2.entry configure -textvariable username
set username Mephis.bbs

..f3.label configure -text "Pass:"
..f3.entry configure -textvariable password -show "*"
set password secret

pack .f1 .f2 .f3 -side top -fill x -padx 1m -pady 2m
focus .f1.entry

--
◎ Origin: 中央松涛站□bbs.ee.ncu.edu.tw  Email: mephis.ttinet.com.tw