
# The GUI for Autohex.
#
# Copyright (c) 1993, 1994 Pacific Marketing and Consulting
# Author:  Wayne A. Christopher, wayne@pmac.com
#          Pacific Marketing and Consulting, Berkeley, California
#
# The remote directory path is $server_dir
# $server_dir/user_list has the list of user names and passwords
# $server_dir/jobs has the job directories
# $server_dir/cvsjobs has the cvs archive for the jobs

proc server_start_running {} {
    global app_name server_start bindir
    
    set server_start(dir) [pwd]
    set server_start(log) [pwd]/server.log
    set server_start(port) 12345
    
    set w [form_init .start_server "Start $app_name server"]
    if {$w != ""} {
	form_label $w.dirl "Server directory" {0 0}
	file_select_entry $w.dir server_start(dir) 1 0 \
	    "Select the directory that contains\nthe projects to be served." {0 1}
	form_label $w.logl "Log file" {1 0}
	file_select_entry $w.log server_start(log) 0 1 \
	    "Select the file to log debugging\noutput from the server." {1 1}
	form_label $w.portl "IP port" {2 0}
	form_entry $w.port server_start(port) int {2 1}
	form_finish +300+300
    }
    if ![form_wait .start_server] return
    

    set cmd [list $bindir/icepak -batch -server -server_port \
		 $server_start(port) -server_dir $server_start(dir) \
		 >>& $server_start(log) &]
    mess $cmd\n
    eval exec $cmd
    mess "Started icepak server.\n"
}

proc server_start {} {
    global server_dir server_port server_users
    
    mess "\n------------------\n"
    mess "Running server pid [pid] on socket $server_port\n"
    mess "In directory $server_dir\n"
    mess "Started at [cmd_date]\n\n"
    
    cd $server_dir
    if [file exists user_list] {
	set fp [open $user_list r]
	while {![eof $fp]} {
	    set line [gets $fp]
	    if {[string match \#* $line] || ([llength $line] != 2)} continue
	    set server_users([lindex $line 0]) [lindex $line 1]
	}
	close $fp
	mess "Got information for [array size server_users] users\n"
    }
    
    socket -server server_one_connection $server_port
    vwait variable_never_set
}

proc server_one_connection {fp other_addr other_port} {
    global server_users
    
    mess "Got a connection from $other_addr, port $other_port\n"
    fconfigure $fp -translation binary
    set hello [gets $fp]
    set user [lindex $hello 1]
    set pass [lindex $hello 2]
    if {([lindex $hello 0] != "hello") ||
	![info exists server_users($user)] ||
	([lindex $server_users($user) 0] != $pass)} {
	mess "Error: bad user/pass line: $hello\n"
	close $fp
	mess "Closed connection\n\n"
	return
    }
    mess "User validated: $user\n"
    
    while {![eof $fp]} {
	set cmd [gets $fp]
	if {$cmd == "end"} {
	    puts $fp end
	    break
	}
	mess "request $cmd\n"
	if {[info command server_cmd_$cmd] != ""} {
	    server_cmd_$cmd $fp
	    flush $fp
	} else {
	    mess "unknown command\n"
	}
    }
    close $fp
    mess "Closed connection\n\n"
}

proc server_cmd_read_job {fp} {
    global server_dir
    
    set files ""
    set vers ""
    
    while {![eof $fp]} {
	set line [gets $fp]
	mess "$line\n"
	switch [lindex $line 0] {
	    only_files {
		set files [lrange $line 1 end]
	    }
	    version {
		set vers [lrange $line 1 end]
	    }
	    job {
		server_check_out [lindex $line 1]
		set dir $server_dir/jobs/[lindex $line 1]
		server_put_all_files_in_dir $fp $dir $vers $files 1
		break
	    }
	    default {
		mess "unknown parameter"
	    }
	}
    }
    mess "done reading project\n"
}

proc server_cmd_write_job {fp} {
    global server_dir
    
    set vers ""
    
    while {![eof $fp]} {
	set line [gets $fp]
	mess "$line\n"
	switch [lindex $line 0] {
	    version {
		set vers [lrange $line 1 end]
	    }
	    job {
		set dir $server_dir/jobs/[lindex $line 1]
		cmd_mkdir $dir
		while {![eof $fp]} {
		    set line [gets $fp]
		    switch [lindex $line 0] {
			file {
			    server_get_one_file_in_dir $fp \
				$dir/[lindex $line 1] \
				[lindex $line 2] $vers 1
			}
			end {
			    break
			}
		    }
		}
		server_check_in [lindex $line 1]
		break
	    }
	}
    }
    mess "done reading project\n"
}

proc server_check_out {dir} {
    global server_dir env bindir
    
    if [file exists $server_dir/cvsjobs/$dir] {
	cd $server_dir/jobs
	set env(CVSROOT) $server_dir/cvsjobs
	cmd_rm $dir
	exec $bindir/cvs checkout $dir
    }
}

proc server_check_in {dir} {
    global server_dir env bindir
    
    cd $server_dir/jobs/$dir
    set env(CVSROOT) $server_dir/cvsjobs
    if [file exists $server_dir/cvsjobs/$dir] {
	exec cvs commit -m nomessage >&@stdout
    } else {
	exec cvs import -m nomessage -kb $dir none start
    }
}

proc server_cmd_list_directory {fp} {
    global server_dir
    
    while {![eof $fp]} {
	set line [gets $fp]
	mess "$line\n"
	switch [lindex $line 0] {
	    dirname {
		set dirname [lrange $line 1 end]
	    }
	    get_dirs {
		set get_dirs [lindex $line 1]
	    }
	    want_dirs {
		set want_dirs [lindex $line 1]
	    }
	    sort_type {
		set sort_type [lindex $line 1]
	    }
	    end {
		break
	    }
	}
    }
    
    set files [file_select_do_list $server_dir/jobs/$dirname $get_dirs $want_dirs $sort_type \
		   "" 1 directory_is_job 0 ""]
    foreach f $files {
	puts $fp $f
    }
    puts $fp end
    mess "done listing directory\n"
}

# -----------------------------------------------------------

proc server_send_request {data callback datafunc} {
    global server_host server_port server_user server_password
    
    if [catch {socket $server_host $server_port} fp] {
	user_error "socket $server_host $server_port\n$fp"
	return __cant_connect__
    }
    fconfigure $fp -translation binary
    puts $fp "hello \"$server_user\" \"$server_password\""
    puts -nonewline $fp $data
    if {$datafunc != ""} {
	eval $datafunc $fp
    }
    puts $fp end
    flush $fp
    
    set return ""
    while {![eof $fp]} {
	set cmd [gets $fp]
	if {$cmd == "end"} break
	if {$callback != ""} {
	    lappend return [eval $callback \"$cmd\" $fp]
	} else {
	    lappend return $cmd
	}
    }
    
    close $fp
    return $return
}

# -------------------------

proc server_read_job {name localdir how tag_version_or_date whatfiles} {
    set data ""
    if {$how != "current"} {
	append data "version $how $tag_version_or_date\n"
    }
    if {$whatfiles != ""} {
	append data "only_files $whatfiles\n"
    }
    append data "job \"$name\"\n"
    cmd_mkdir $localdir
    server_send_request "read_job\n$data" \
	"server_read_job_callback $localdir" ""
}

proc server_read_job_callback {localdir line fp} {
    switch [lindex $line 0] {
	file {
	    server_get_one_file_in_dir $fp $localdir/[lindex $line 1] \
		[lindex $line 2] "" 1
	}
	default {
	    mess "Unknown command $line from server\n"
	}
    }
}

# -------------------

proc server_write_job {name localdir how tag_version_or_date whatfiles} {
    set data ""
    if {$how != "current"} {
	append data "version $how $tag_version_or_date\n"
    }
    append data "job \"$name\"\n"
    server_send_request "write_job\n$data" "" \
	[list server_write_job_datafunc $localdir $whatfiles]
}

proc server_write_job_datafunc {localdir whatfiles fp} {
    server_put_all_files_in_dir $fp $localdir "" $whatfiles 1
    puts $fp end
}

# -------------------

proc server_list_directory {current dirs want_dirs sort_type} {
    global server_directory_list
    set data ""
    append data "dirname \"$current\"\n"
    append data "get_dirs $dirs\n"
    append data "want_dirs $want_dirs\n"
    append data "sort_type $sort_type\"\n"
    return [server_send_request "list_directory\n$data" "" ""]
}

# -----------------------------------------------------------

proc server_put_all_files_in_dir {fp dir vers only_files debug} {
    #puts "server_put_all_files_in_dir $fp $dir \"$vers\" \"$only_files\" $debug"
    set files [glob_fixed $dir/*]
    foreach f $files {
	set type [file type $f]
	if {$type != "file"} continue
	set f1 [file tail $f]
	if {($files != "") && ([lsearch $only_files $f1] < 0)} continue
	
	set size [file size $f]
	puts $fp [list file $f1 $size]
	set fp1 [open $f r]
	fconfigure $fp1 -translation binary
	fcopy $fp1 $fp -size $size
	close $fp1
	if $debug { mess "sent file $f, $size bytes\n" }
    }
}

proc server_get_one_file_in_dir {fp file size vers debug} {
    global server_mode
    
    set fp1 [open $file w]
    fconfigure $fp1 -translation binary
    fcopy $fp $fp1 -size $size
    close $fp1
    if $debug {
	if $server_mode {
	    mess "copied file $file from client - $size bytes\n"
	} else {
	    mess "Copied file $file from server - $size bytes\n"
	}
    }
}
