#
# $Source: /home/nlfm/Working/Zircon/Released/plugins/Dcc/RCS/dccsend.tcl,v $
# $Date: 2001/07/10 15:36:14 $
# $Revision: 1.18.1.8 $
#
package provide Dcc 1.18
#
switch -glob -- [info tclversion] 7.* {
#
#
proc acceptSend {net key file usr chan hst port} {
    global zircon
    upvar #0 Offer$net Offer Send$net Send
    if {[catch {set x [lsearch $Offer($usr) "$key *"]}]} {
	catch {close $chan}
	tellError {} {Cancelled send accepted.}
	return 0
    }
    set v [lindex $Offer($usr) $x]
    close [lindex $v 2]
    if {[catch {set fd [open "|[file join $zircon(lib) plugins Dcc dccsend] $file\
      [lindex $v 4] $usr <@$chan 2>@$chan" r]} msg]} {
	close $chan
	tellError {} {Prog error} "Cannot run DCC helper program dccsend - \"$msg\"
Check your installation"
	return 0
    }
    catch {fconfigure $fd -buffering line -translation lf}
    fileevent $fd readable "handleInfo $net $fd"
    set v [list $fd $file [lindex $v 3] [lindex $v 4]]
    close $chan
    if {![info exists Send($usr)]} {$usr ref}
    lappend Send($usr) $v
    listdel Offer($usr) $x
    switch {} $Offer($usr) {unset Offer($usr)}
    if {[winfo exists .@dls$net]} { buildDCCList $net }
    dccWindow $fd $usr Send $file
    return 1
}
} default {
proc acceptSend {net key file usr chan hst port} {
    global zircon
    upvar #0 Offer$net Offer Send$net Send
    if {[catch {set x [lsearch $Offer($usr) "$key *"]}]} {
	catch {close $chan}
	tellError {} {Cancelled send accepted.}
	return 0
    }
    set v [lindex $Offer($usr) $x]
    close [lindex $v 2]
    set v [list $chan $file [lindex $v 3] [lindex $v 4]]
    if {![info exists Send($usr)]} {$usr ref}
    lappend Send($usr) $v
    listdel Offer($usr) $x
    switch {} $Offer($usr) {unset Offer($usr)}
    if {[catch {open $file RDONLY} g]} {
        endDCC Send $usr $chan $net "Cannot read $file : $g"
        return 0
    }
    set leng [file size $file]
    if {[set posn [lindex $v 4]] != {} && $posn > 0} {
        if {[catch {seek $g $posn start} msg]} {
	    endDCC Send $usr $chan $net "Cannot seek $file : $msg"
	    close $g
	    return 0
	}
        incr leng  -$posn
    } 
    if {$leng == 0} {
	close $g
        dccWindow $chan $usr Send $file
	endDCC Send $usr $chan $net "Transfer completed."
	return 1
    }
    set st [clock seconds]
    fconfigure $g -translation binary
    if {[catch {set buffer [read $g [$net dccblock]]} msg]} {
        endDCC Send $usr $chan $net "Error reading $file : $msg"
	close $g
	return 0
    }
    global tl
    set tl($chan) [string length $buffer]
    fconfigure $chan -blocking 0 -buffering none -translation binary
    if {[catch {puts -nonewline $chan $buffer} msg]} {
        endDCC Send $usr $chan $net "Write error : $msg"
	close $g
	return 0
    }
    fileevent $chan readable "dccSendEvent $chan $g $st $leng $usr $net"
    dccWindow $chan $usr Send $file
    if {[winfo exists .@dls$net]} { buildDCCList $net }
    return 1
}
#
proc dccSendEvent {sk fd st leng who net} {
    if {[eof $sk]} {
        endDCC Send $who $sk $net "Transfer interrupted"
	close $fd
	return
    }
    if {[catch {set l [read $sk 4]} msg]} {
        endDCC Send $who $sk $net "Read error : $msg"
	close $fd
	return
    }
    if {[string length $l] == 0} {
        endDCC Send $who $sk $net "Sync read error"
	close $fd
	return
    }
    global tl
    set cl 0
    binary scan $l I1 cl
    if {$cl != $tl($sk)} { return }
    if {[eof $fd]} {
        if {[set st [expr {[clock seconds] - $st}]] == 0} {
	    set st 1
        }
	close $fd
	endDCC Send $who $sk $net \
	  "Transfer completed. [expr {$leng / (1000.0 * $st)}] Kbytes/sec"
	return
    }
    if {[catch {set buffer [read $fd [$net dccblock]]} msg]} {
        endDCC Send $who $sk $net "Error reading $file : $msg"
	close $fd
	return
    }
    if {[set lng [string length $buffer]] == 0} {
        if {[set st [expr {[clock seconds] - $st}]] == 0} {
	    set st 1
        }
	close $fd
	endDCC Send $who $sk $net \
	  "Transfer completed. [expr {$leng / (1000.0 * $st)}] Kbytes/sec"
	return
    }
    incr tl($sk) $lng
    if {[catch {puts -nonewline $sk $buffer} msg]} {
        endDCC Send $who $sk $net "Write error : $msg"
	close $fd
	return
    }
    if {[set dt [expr {[clock seconds] - $st}]] == 0} {
        set elt 0
    } {
        set elt [expr {($leng - $tl($sk)) / ($tl($sk) /([clock seconds] - $st))}]
    }
    dccProgress $sk $tl($sk) [expr {($tl($sk) * 100.0) / $leng}] \
      [expr {$elt / 60}] [expr {$elt % 60}]
}
}
