#
# $Source: /home/nlfm/Working/Zircon/Released/plugins/Dcc/RCS/send.tcl,v $
# $Date: 2001/07/10 15:36:14 $
# $Revision: 1.18.1.32 $
#
package provide Dcc 1.18
#
proc DCCSend {usr file} {
    switch {} $file return
    if {[file exists $file]} {
	if {![file readable $file]} {
	    tellError {} {File error} "Cannot read file \"$file\"."
	    return
	}
	set net [$usr net]
	set xfile [file tail $file]
	set file [file join [file dirname $file] $xfile]
	upvar #0 Offer$net Offer
	set ky [newName Scon]
	set sock [socket -server "acceptSend $net $ky [list $file] $usr" 0]
	if {[catch {fconfigure $sock -sockname} xx]} {
	    error "Cannot get port for server - $xx"
	}
	if {![info exists Offer($usr)]} { $usr ref }
	lappend Offer($usr) [list $ky $file $sock [lindex $xx 2] 0 0]
	$net CTCP DCC [$usr name] \
	  "SEND [deSpace $xfile] [ipPack [ipAddress]] [lindex $xx 2] [file size $file]"
	if {[winfo exists .@dls$net]} { buildDCCList $net }
    } {
	tellError {} {File error} "File \"$file\" does not exist."
    }
}
#
switch -glob -- [info tclversion] 7.* {
#
proc handleInfo {net conn} {
    if {[catch {gets $conn} msg] || ([string match {} $msg] && [eof $conn])} {
	catch {close $conn}
    } {
	zIn "! $msg" $net
#	regsub -all {[\\{\"}]} $msg {\\&} sp
	set sp [split $msg]
	switch {} [set who [lindex $sp 5]] {error "Bad Info line - {$msg}"}
	set msg [join [lreplace [lrange $sp 1 end] 4 4 [$who name]]]
	switch -glob -- $msg {
	{DCC Get prog*} -
	{DCC Send prog*} {
		catch {dccProgress $conn [lindex $sp 6] [lindex $sp 7] \
		  [lindex $sp 8] [lindex $sp 9]}
	    }
	{DCC Send*} -
	{DCCError Send*} {endDCC Send $who $conn $net $msg}
	{DCCError Get*} -
	{DCC Get*} {endDCC Get $who $conn $net $msg}
	default {
		mkInfoBox $net DCCINFO .@dcc$conn {DCC Info} "WEIRD ERROR : $msg"
	    }
	}
    }
}
#
}
#
proc endDCC {type who conn net msg args} {
    upvar #0 $type$net gsnet
    if {![catch {lsearch $gsnet($who) "$conn *"} x]} {
        set file [lindex [lindex $gsnet($who) $x] 1]
        listdel gsnet($who) $x
        switch {} $gsnet($who) {unset gsnet($who)}
    } {
#
# This should really never happen, but it does seem to sometimes
# so rather than try to find the real cause, I'll just trap the error....
#
        set file {}
    }
    if {![winfo exists .@$conn]} {
	$net inform $msg
    } {
	catch {destroy .@$conn.slide .@$conn.txt}
	if {[winfo exists .@$conn.done]} {
	    .@$conn.done configure -text $msg
	} {
	    grid [label .@$conn.done -text $msg] -row 0 -sticky ew -padx 10 -pady 10
	}
	.@$conn.cancel configure -text [trans dismiss] -command "destroy .@$conn"
    }
    if {[catch {close $conn} msg]} {
        $net inform "Error closing DCC connection : $msg"
    }
    catch {uplevel #0 unset tl($conn)}
    switch $type Get {
        switch {} $args {} default {
	    if {[lindex $args 0]} { $net fileProcess $file $who }
	}
    }
    if {[winfo exists .@dls$net]} { buildDCCList $net }
}
#
proc dccAutoDir {net fln} {
    foreach x [$net autogetdir] {
	set dir [lindex $x 0]
	switch {} [set rx [lindex $x 1]] {set rx .*}
	if {[regexp -- $rx $fln]} {return $dir}
    }
    return {}
}
#
switch -glob [info tclversion] 8* - {7.6} {
#
proc handleSend {net fln usr addr port leng posn auto} {
    global GetDir zFileTypes
    if {$auto} {
	switch {} [set fl [dccAutoDir $net $fln]] {} default {
	    doGetDCC $net Get $usr $addr $port $leng $posn \
		[file join $fl $fln]
	    return
	}
    }
    if {![info exists GetDir($net)]} {
	switch {} [set GetDir($net) [dccAutoDir $net $fln]] {
	    if {[catch {set GetDir($net) [pwd]} msg]} {
		tellError $net "pwd error" "Cannot get working directory name : $msg"
	    }
	}
    }
    set dir $GetDir($net)
    set msg "DCC Send request ($fln) from [$usr name]"
    if {[catch {switch {} [set fl [tk_getSaveFile -initialdir $dir -initialfile $fln \
      -filetypes $zFileTypes]] {
# user cancelled the op. Should we do something?
    } default {
	set GetDir($net) [file dirname $fl]
	doGetDCC $net Get $usr $addr $port $leng $posn $fl
    }} err]} {
        $net errmsg "File error: $err"
    }
}
#
} default {
#
proc handleSend {net fln usr addr port leng posn auto} {
    if {$auto} {
	switch {} [set fl [dccAutoDir $net $fln]] {} default {
	    doGetDCC $net Get $usr $addr $port $leng $posn \
		[file join $fl $fln]
	    return
	}
    }
    global GetDir
    if {![info exists GetDir($net)]} {
	switch {} [set GetDir($net) [dccAutoDir $net $fln]] {
		if {[catch {set GetDir($net) [pwd]} msg]} {
		    tellError $net "pwd error" "Cannot get working directory name : $msg"
		}
	}
    }
    set msg "DCC Send request ($fln) from [$usr name]"
    tkwait window [mkFileBox {} GetDir($net) .* "DCC Send $fln" $msg $fln \
      [list accept "doGetDCC $net Get $usr $addr $port $leng $posn"] \
      [list reject {}]]
}
#
}
#
proc handleResume {net usr file port posn} {
    upvar #0 Offer$net Offer
    set i 0
    set fnd 0
    if {![info exists Offer($usr)]} {
	warnUser {Resume Error} "Asked to Resume, but no DCC offer to [$usr name] outstanding!"
    } {
	foreach l $Offer($usr) {
	    switch -- $port [lindex $l 3] {
		set Offer($usr) [lreplace $Offer($usr)\
		  $i $i [lreplace $l 4 4 $posn]]
		$net CTCP DCC [$usr name] "ACCEPT [deSpace $file] $port $posn"
		set fnd 1
		break
	    }
	    incr i
	}
	if {!$fnd} {
	    warnUser {Resume Error} "Asked to Resume, but cannot find matching offer to [$usr name]!"
	}
    }
}
#
proc handleAccept {net usr fln port posn} {
    global Resume
    if {![info exists Resume($usr)]} {
	    warnUser {Resume Error} "Asked to Accept a resume, but cannot find matching offer to [$usr name]!"
    } {
	set i 0
	foreach l $Resume($usr) {
	    switch $port [lindex $l 2] {
		foreach {file addr port leng posn} $l break
		doGetDCC $net Get $usr $addr $port $leng $posn $file
		listdel Resume($usr) $i
		switch {} $Resume($usr) {unset Resume($usr)}
		break
	    }
	    incr i
	}
    }
}