#!/usr/bin/wish ### ### Remote controller program ### set initialize_amsn 1 proc readsocket { } { global sock set complete 0 set response "" while { [info exists sock] && $complete == 0 } { if { [gets $sock tmp] == -1 } { .controler.res.txt insert end "Amsn server closed\n" error .controler.res.txt yview moveto 1.0 fileevent $sock readable "" destroy .controler connect "Amsn server closed" } elseif {$tmp != "" } { append response $tmp append response "\n" set complete [info complete $response] if { $complete } { set data [lindex $response 0] set colour [lindex $response 1] .controler.res.txt insert end $data $colour .controler.res.txt insert end "\n" $colour .controler.res.txt yview moveto 1.0 } } } } proc writesocket { } { global sock set command [.controler.entry get] .controler.entry delete 0 end .controler.res.txt insert end "\n$command\n" command .controler.res.txt yview moveto 1.0 set command [string map { \; \\\; \" \\\" \[ \\\[ \] \\\] \: \\\: \\ \\\\ \* \\\* \? \\\?} $command] # set command [join $command] if { "$command" != "quit" } { puts ${sock} $command flush $sock } else { destroy .controler } } proc authenticate { password } { global sock puts ${sock} "auth" flush $sock gets $sock response set response [lindex $response 0] if { "[lindex $response 0]" != "auth" } { return "fail" } else { set hash [::md5::hmac "[lindex $response 1]" "$password"] puts $sock "auth2 $hash" flush $sock gets $sock response set response [lindex $response 0] if { "$response" == "Authentication successfull" } { return "OK" } elseif { "$response" == "Authentication failed" } { return "fail" } else { return "disabled" } } } proc connect { status } { global sockDS stat set ip [.ip get] if { [catch {toplevel .connect}] } { destroy .connect toplevel .connect } wm group .connect . if { $sockDS == 0 } { set stat [catch {socket $ip 63251} sockDS] set status "Connected to the server" } if { $stat != 0 } { label .connect.status -text "Error connecting to server\n$sockDS" button .connect.ok -text "OK" -command "destroy .connect" set sockDS 0 grid .connect.status -row 0 -column 0 grid .connect.ok -row 2 -column 1 bind .connect "grab release .connect" grab set .connect } else { label .connect.status -text "$status" button .connect.ok -text "Connect to account" -command "retreive_port $ip" label .connect.acc_l -text "Account :" entry .connect.acc label .connect.pass_l -text "Password for remote access :" entry .connect.pass -show "*" button .connect.cancel -text "Cancel" -command "close $sockDS;set sockDS 0; destroy .connect" grid .connect.status -row 0 -column 2 grid .connect.ok -row 2 -column 3 grid .connect.cancel -row 3 -column 3 grid .connect.acc_l -row 2 -column 0 grid .connect.acc -row 2 -column 2 grid .connect.pass_l -row 3 -column 0 grid .connect.pass -row 3 -column 2 bind .connect { if {"%W" == ".connect"} { grab release .connect } } bind .connect.acc "retreive_port $ip" bind .connect.pass "retreive_port $ip" grab set .connect focus -force .connect.acc } } proc retreive_port { ip } { global sockDS sock set account [.connect.acc get] set password [.connect.pass get] puts $sockDS "$account" if { [catch { flush $sockDS}] } { set sockDS 0 connect "Disconnected from the DS server" return 0 } set port [gets $sockDS] if { "$port" == "invalid" } { connect "This Amsn Account is invalid" return 0 } if { "$port" == "noexist" } { connect "The Amsn profile file doesn't exist or you don't have permissions to read from it" return 0 } if { "$port" == "versionerror" } { connect "The Amsn profile file has an invalid version" return 0 } if { [catch {socket $ip $port} sock] != 0 } { connect "This Amsn Account isn't connected" return 0 } else { fconfigure $sock -buffering line if { [set auth_response [authenticate "$password"]] == "fail" } { connect "Password incorrect or not set" return 0 } elseif { $auth_response == "disabled" } { connect "This account doesn't have remote controlling enabled" return 0 } else { fileevent $sock readable "readsocket" connect "Connected to Account on port : $port" after 500 control return 1 } } } proc control { } { global sock toplevel .controler wm group .controler . wm title .controler "Remote Controler Shell" frame .controler.res -class Degt text .controler.res.txt -height 40 -width 120 \ -wrap none -background white -foreground black \ -yscrollcommand ".controler.res.sy set" \ -xscrollcommand ".controler.res.sx set" scrollbar .controler.res.sy -command ".controler.res.txt yview" scrollbar .controler.res.sx -orient horizontal -command ".controler.res.txt xview" .controler.res.txt tag configure error -foreground red -background white .controler.res.txt tag configure command -foreground gray88 -background white .controler.res.txt tag configure normal -foreground black -background white .controler.res.txt tag configure msgsent -foreground brown -background white .controler.res.txt tag configure msgrcv -foreground blue -background white .controler.res.txt tag configure event -foreground green -background white pack .controler.res.sy -side right -fill y pack .controler.res.sx -side bottom -fill x pack .controler.res.txt -anchor nw -expand true -fill both entry .controler.entry -width 50 button .controler.close -text "Close" -command "destroy .controler" pack .controler.res -expand true -fill both pack .controler.entry -fill x pack .controler.res .controler.entry -side top bind .controler.entry "writesocket" grab set .controler bind .controler { if { "%W" == ".controler" } { close $::sock unset ::sock grab release .controler } } focus -force .controler.entry } proc main { } { global sockDS wm group . . wm geometry . wm title . "Amsn Remote Controller" button .con -text "Connect" -command "connect \"Connected to the server\"" label .lab -text "Enter the IP address of the host : " entry .ip grid .lab -row 0 -column 0 grid .ip -row 0 -column 2 grid .con -row 0 -column 10 -sticky w bind .ip "connect \"Connected to the server\"" focus -force .ip } ############################################################ ### Look if we are launched from a link ### and set the correct working directory ############################################################ #Fixed by Tomasz Nguyen set program_dir [file dirname [info script]] set program [file tail [info script]] while {[catch {file readlink [file join $program_dir $program]} program]== 0} { if {[file pathtype $program] == "absolute"} { set program_dir [file dirname $program] } else { set program_dir [file join $program_dir [file dirname $program]] } set program [file tail $program] } set starting_dir [pwd] cd $program_dir set program_dir [pwd] unset program #unset program_dir source [file join $program_dir migmd5.tcl] set sockDS 0 main