#!/bin/sh
#-*- mode: tcl; -*- \
exec /usr/local/bin/tclsh8.0 "$0" "$@"

#package require cgi
source /net/servers/www-sop/croap/personnel/Laurent.Thery/cgi.tcl
 
######################################################################

# CGI specific settings

cgi_debug -off

cgi_uid_check -off
cgi_admin_mail_addr thery@sophia.inria.fr
cgi_name "CGI upload script"

set _cgi(no_binary_upload) 1

set uploadArea "/net/servers/www-sop/croap/TPHOLs99/"

set papertypes [list "draft" "final"]
set conferences [list "TPHOLs99"]

set categoryText(completed) "completed work"
set categoryText(progress)  "work in progress"
set categoryText(research)  "formal research"

set formatText(ps)  "Postscript"
set formatText(pdf) "PDF"
set formatText(tar.gz) "tar file, compressed with GNU gzip"
set formatText(tar.Z) "tar file, compressed with Unix compress"
set formatText(tar) "tar file, not compressed"
set formatText(zip) "zip file, DOS/Windows style"
set formatText(tex) "LaTeX file, standalone"

set compressText(gunzip)     "GNU gzip"
set compressText(uncompress) "UNIX compress"
set compressText(false)      "None"

   
# upload_copyFile --
#
# Copy an uploaded file to a cool place.
#
# Parameters:
#
#	filevariablename (input) -
#		Name of a variable that represents the upload file.
#
# Returns:
#	A list containing a submission number and the name of the
#	copied file.

proc upload_copyFile {filevariablename} {

    set prefix [upload_getPrefix]

    set local  [cgi_import_filename -local  ${filevariablename}]
    set remote [cgi_import_filename -remote ${filevariablename}]

    if {[string length $remote] == 0} {
	
	cgi_h1 "Oops!"
	cgi_hr
	cgi_p "You don't seem to have submitted a file!  Hit the \"back\" button in your browser, select a file to upload and resubmit."
	cgi_hr
	upload_unlock
	cgi_exit
    }
	
    #cgi_p "Uploaded: $remote, \"[exec ls -l $local]\""

    # Work out the number of this upload.
    set currentFile "${prefix}.current"
    if {[catch {set fd [open ${currentFile} "r"]}]} {
	set num 1
    } else {
	set num [string trim [read ${fd}]]
	close ${fd}
    }

    set fd [open ${currentFile} "w"]
    puts -nonewline ${fd} [expr {${num} + 1}]
    close ${fd}
    catch {exec chmod g+w "${currentFile}"}
    
    set newDir "${prefix}-[format {%04s} ${num}]"
    #cgi_puts "prefix=${prefix}"

    file mkdir ${newDir}
    catch {exec chmod g+ws ${newDir}}

    set target [file join ${newDir} [file tail ${remote}]]
    file copy ${local} ${target}
    catch {exec chmod g+w ${target}}
    file delete ${local}

    return [list ${num} ${target}]
}

# upload_dolog --
#
# Log an upload.
#
# Parameters:
#
#	num (input) -
#		The number given to the current submission.
#	fname (input) -
#		Full name of the uploaded file.
#
# Returns:
#	Some HTML to show to the submitter.

proc upload_dolog {num fname} {

    global confFields
    global categoryText
    global formatText
    global compressText

    set prefix [upload_getPrefix]

    set fileName [file tail ${fname}]
    set fileSize [file size ${fname}]

    cgi_import conference
    cgi_import papertype
    cgi_import category

    set logText  "[format {%04d} ${num}]|${category}|${fileName}|${fileSize}"
    set htmlGuts [cgi_buffer {
	cgi_table_row align=left {
	    cgi_th "Filename:"
	    cgi_td ${fileName}
	}
	cgi_table_row align=left {
	    cgi_th "File size:"
	    cgi_td "${fileSize} bytes (binary files usually grow harmlessly by about 2 bytes)"
	}
    }]

    cgi_import title
    append logText "|${title}"
    append htmlGuts [cgi_buffer {
	cgi_table_row align=left {
	    cgi_th "Title:"
	    cgi_td ${title}
	}
    }]

    cgi_import author
    append logText "|${author}"
    append htmlGuts [cgi_buffer {
	cgi_table_row align=left {
	    cgi_th "Contact name:"
	    cgi_td ${author}
	}
    }]

    cgi_import email
    append logText "|${email}"
    append htmlGuts [cgi_buffer {
	cgi_table_row align=left {
	    cgi_th "Contact e-mail:"
	    cgi_td ${email}
	}
    }]

    cgi_import fax
    append logText "|${fax}"
    append htmlGuts [cgi_buffer {
	cgi_table_row align=left {
	    cgi_th "Contact fax:"
	    cgi_td ${fax}
	}
    }]

    cgi_import format
    append logText "|${format}"
    append htmlGuts [cgi_buffer {
	cgi_table_row align=left {
	    cgi_th "Submission format:"
	    cgi_td $formatText(${format})
	}
    }]

    if {${papertype} == "draft"} {
	
	cgi_import compression
	append logText "|${compression}"
	append htmlGuts [cgi_buffer {
	    cgi_table_row align=left {
		cgi_th "Compression used:"
		cgi_td $compressText(${compression})
	    }
	}]
    
	    
        if {${conference} == "TPHOLs99"} {

	    if {[catch {cgi_import toolList}]} {
		set toolList [list]
	    }

	    if {! [catch {cgi_import otherTool}]} {
		lappend toolList ${otherTool}
	    }
	    set theTools [join ${toolList} ", "]

	    append logText "|${theTools}"
	    append htmlGuts [cgi_buffer {
		cgi_table_row align=left {
		    cgi_th "Systems discussed by your paper:"
		    cgi_td ${theTools}
		}
	    }]
	}

        if {[catch {cgi_import areaList}]} {
	    set areaList [list]
        }

        if {! [catch {cgi_import otherAreas}]} {
            lappend areaList ${otherAreas}

	    #cgi_puts "x[llength ${otherAreas}]x"
	    #cgi_preformatted {
            #    cgi_puts ${otherAreas}
	    #}
	}
	set theAreas [join ${areaList} ", "]

	regsub -all -- "\n" ${theAreas} "; " theAreas

	append logText "|${theAreas}"
	append htmlGuts [cgi_buffer {
	    cgi_table_row align=left {
		cgi_th "Key areas:"
		cgi_td ${theAreas}
	    }
	}]
    }

    set html [cgi_buffer {

	cgi_h1 "Submission received:"

	cgi_p "Thank you for submitting a ${papertype}, $categoryText(${category}) paper to ${conference} .  We have recorded the following details:"

	cgi_table {
	    cgi_puts ${htmlGuts}
	}
    }]

    set fd [open "${prefix}.log" "a+"]
    puts ${fd} ${logText}
    close ${fd}
    catch {exec chmod g+w "${prefix}.log"}

    return ${html}
}

# upload_get_prefix --
#
# Determine the filename prefix for uploaded files.
#
# Parameters:
#
# 	None.
#
# Returns:
#	The submission filename prefix.

proc upload_getPrefix {} {

    global uploadArea
    global conferences
    global papertypes
    
    cgi_import conference
    upload_validate conference ${conferences} ${conference}
    set confPref [file join ${uploadArea} "${conference}-upload-area"]
    
    cgi_import papertype
    upload_validate papertype ${papertypes} ${papertype}

    return [file join ${confPref} ${papertype}]
}

# upload_lock --
#
# Lock a conference upload area so only 1 paper of the given papertype
# can be uploaded into the area until it is unlocked.

proc upload_lock {} {

    set filename "[upload_getPrefix].lock"

    # Use an exponential back-off locking scheme.  Times are in
    # milliseconds.
    set timeout 100
    set locked 0
    while {(! ${locked}) && (${timeout} <= 2000)} {

	set locked [expr {! [catch {set fd [open ${filename} [list WRONLY CREAT EXCL]]}]}]
	if {! ${locked}} {
	    after ${timeout}
	    set timeout [expr 2 * ${timeout}]
	}
    }

    if {${locked}} {
	close ${fd}
    } else {

	cgi_h1 "Oops!"
	cgi_hr

	cgi_p "A reasonable amount of time was spent trying unsuccessfully to lock the file upload area."

	cgi_import conference
	set mailto [cgi_url [cgi_typewriter "${conference}@sophia.inria.fr"] "mailto:${conference}@sophia.inria.fr"]

	cgi_p "Please hit the \"back\" button in your browser and try resubmitting.  If this problem persists, please send e-mail to ${mailto} so that we can fix things."

	cgi_hr
	
	cgi_exit
    }
    return
}

# upload_unlock --
#
# Unlock a conference upload area.  No checking is done to ensure that
# this is the process that owns the lock.  All errors are ignored.
#

proc upload_unlock {} {

    catch {file delete "[upload_getPrefix].lock"}

    return
}

# upload_validate --
#
# Check that $val is is $allowable.  If not, print a message an exit.
# $name is the name of the variable containing $val.

proc upload_validate {name allowable val} {

    if {[lsearch -exact ${allowable} ${val}] == -1} {
	cgi_h1 "Oops!"
	cgi_puts "Invalid value for ${name}=\"${val}\""

	upload_unlock
	cgi_exit
    }
    return
}
    

cgi_eval {

    cgi_input [lindex $argv 0]

    cgi_http_head

    cgi_body {

	if {[catch {
	    upload_lock

	set x [upload_copyFile submission]
	set num   [lindex ${x} 0]
	set fname [lindex ${x} 1]

	cgi_puts [upload_dolog ${num} ${fname}]
   
    }]} {
	upload_unlock

	cgi_h1 "Oops!"
	cgi_hr

	set mailto [cgi_url [cgi_typewriter "Laurent.Thery@sophia.inria.fr"] "mailto:Laurent.Thery@sophia.inria.fr"]
	cgi_p "An internal error occured.  Please e-mail ${mailto} with as much information about your submission as possible, as well as the time!"
	cgi_hr

    }
	upload_unlock
    }
}