Codename_DJ
Codename_DJ

Reputation: 563

Close a tcl server after file copy is complete

I am running a tcl server in VM and a client in windows machine to copy a file from client to vm. The problem is I want the server to close automatically after the task is done. Currently it is not doing it , because "vwait" is set to "forever" .I don't have much knowledge about tcl network programming ,so I can't figure out how to implement it.

My server code

##server side    

set destination_directory /home/media
set service_port  9900
proc receive_file {channel_name client_address client_port} {
    fconfigure $channel_name -translation binary
    gets $channel_name line
    foreach {name size} $line {}

    set fully_qualified_filename [file join $::destination_directory $name]
    set fp [open $fully_qualified_filename w]
    fconfigure $fp -translation binary

    fcopy $channel_name $fp -size $size

    close $channel_name
    close $fp
}


socket -server receive_file $service_port

vwait forever

and my client code:

##client side
set service_port 9900
set service_host 192.168.164.161

proc send_one_file name {
    set size [file size $name]
    set fp [open $name]
    fconfigure $fp -translation binary

    set channel [socket $::service_host $::service_port]
    fconfigure $channel -translation binary
    puts $channel [list $name $size]

    fcopy $fp $channel -size $size

    close $fp
    close $channel
}

send_one_file "sample.pdf"

Please guide.

Upvotes: 0

Views: 147

Answers (2)

Donal Fellows
Donal Fellows

Reputation: 137567

If you want the Tcl script to terminate after the transfer is done, you can just exit after the close.

set destination_directory /home/media
set service_port  9900
proc receive_file {channel_name client_address client_port} {
    fconfigure $channel_name -translation binary
    gets $channel_name line
    foreach {name size} $line {}

    set fully_qualified_filename [file join $::destination_directory $name]
    set fp [open $fully_qualified_filename w]
    fconfigure $fp -translation binary

    fcopy $channel_name $fp -size $size

    close $channel_name
    close $fp
    exit ;     ####  All done with this process
}

socket -server receive_file $service_port
vwait forever

However, it is probably better to use the asynchronous form of fcopy (I've added a bunch of other Tcl 8.5-isms in here too):

set destination_directory /home/media
set service_port  9900
proc receive_file {channel client_address client_port} {
    global destination_directory
    lassign [gets $channel] name size
    fconfigure $channel -translation binary
    if {[catch {
        set fp [open [file join $destination_directory $name] "wb"]
        fcopy $channel $fp -size $size -command [list done_transfer $channel $fp]
    }]} exit
}
proc done_transfer {from_channel to_channel bytes {errorMessage ""}} {
    close $from_channel
    close $to_channel
    exit
}

socket -server receive_file $service_port
vwait forever

A production version of this would probably have code in there to guard against bad filenames, do logging, and possibly to allow multiple connections to be made and for those connections to all finish before the server script finishes. All that makes the code quite a bit longer…

Upvotes: 1

glenn jackman
glenn jackman

Reputation: 246764

Add one more line to the receive_file proc after you close the handles:

set ::forever true   ;# or any other value at all

Upvotes: 1

Related Questions