####################################################################################
##                                                                                ##
##  I N T E R S T E L L A R   C O N S O L E  Info Server                          ##
##                                                                                ##
##            Copyright (C) 2025- Misato Observatory, Wakayama, Japan             ##
##                                                                                ##
##  This software is available under the GPL (General Public License)             ##
##                                                                                ##
##  References:                                                                   ##
##  https://mibai.tec.u-ryukyu.ac.jp/~oshiro/Doc/tcltk_primer/socket-sample.html  ##
##                                                                                ##
####################################################################################

set server_root "."
set port_number 8091

proc add_a_server { sock addr port } {
    fileevent $sock readable "server_handler $sock $addr"
    # "-translation binary" is required to use Japanese
    fconfigure $sock -buffering line -translation binary
    #puts "Connection from $addr registered"
}

proc server_handler { sock addr } {

  global server_root

  #
  # Read request and header of a client
  #
  set request_str [string trim [gets $sock]]
  while 1 {
    set header_str [string trim [gets $sock]]
    if { [string length $header_str] == 0 } {
      break
    }
  }

  #
  # Check request
  #
  set request_list [split $request_str " "]
  set bad_request 0
  set flg_server_test 0
  set flg_req_new_remote_id 0
  if { [llength $request_list] < 2 } {
    set bad_request 1
  } else {
    if { [lindex $request_list 0] ne "GET" } {
      set bad_request 1
    } else {
      set requested_file $server_root
      set fname [lindex $request_list 1]
      #puts $fname
      append requested_file $fname
      if { $fname eq "/" } {
        set flg_server_test 1
      } elseif { $fname eq "/new_remote_id" } {
        set flg_req_new_remote_id 1
      }
    }
  }

  #
  # Response
  #
  if { [eof $sock] } {
    close $sock
  } else {
    if { $flg_req_new_remote_id != 0 } {
      #
      # Exclusive control for remote console
      #
      set found_id ""
      for {set i 1} {$i <= 9} {incr i} {
        set filename "$server_root/isc_remote/$i"
        if { [catch {open $filename r} fid] } {
          # do nothing
        } else {
          set line ""
          if { [gets $fid line] >= 0 } {
            if { [string trim $line] eq $addr } {
              set found_id $i
            }
          }
          catch {close $fid}
        }
        if { $found_id ne "" } {
          break
        }
      }
      if { $found_id eq "" } {
        for {set i 1} {$i <= 9} {incr i} {
          set filename "$server_root/isc_remote/$i"
          if { [catch {open $filename {WRONLY CREAT EXCL}} fid] } {
            # do nothing
          } else {
            puts $fid "$addr"
            set found_id $i
            catch {close $fid}
          }
          if { $found_id ne "" } {
            break
          }
        }
      }
      puts $sock "HTTP/1.0 200 OK\r"
      puts $sock "Server: ISC Info Server\r"
      puts $sock "Content-Type: text/plain\r"
      puts $sock "\r"
      puts "200 GET: /new_remote_id = $found_id ($addr)"
      puts -nonewline $sock "$found_id\n"
    } elseif { $flg_server_test != 0 } {
      puts $sock "HTTP/1.0 200 OK\r"
      puts $sock "Server: ISC Info Server\r"
      puts $sock "Content-Type: text/plain\r"
      puts $sock "\r"
      puts $sock "ok,$server_root\r"
      puts "200 GET: info"
    } elseif { $bad_request != 0 } {
      puts $sock "HTTP/1.0 501 Not Implemented Error\r"
      puts $sock "\r"
      puts "501 ERROR"
    } else {
      #
      # Opens a file and returns its contents.
      #
      if { [catch {open $requested_file r} fh] } {
        puts $sock "HTTP/1.0 404 Not Found\r"
        puts $sock "\r"
        puts "404 ERROR: '$requested_file'"
      } else {
        #
        # "-translation binary" is required to use Japanese
        fconfigure $fh -buffering line -translation binary
        #
        puts $sock "HTTP/1.0 200 OK\r"
        puts $sock "Server: ISC Info Server\r"
        puts $sock "Content-Type: text/plain\r"
        puts $sock "\r"
        #puts "200 GET: '$requested_file'"
        #
        while { [gets $fh txt_line] >= 0 } {
          puts -nonewline $sock "$txt_line\n"
        }
        close $fh
      }
    }
    close $sock
  }

}

if { 0 < $argc } {
  set server_root [regsub -all {\\} [lindex $argv 0] {/}]
}
if { 1 < $argc } {
  set port_number [lindex $argv 1]
}

puts "// Interstellar Console Info Server //"
puts "server_root: $server_root"
puts "port_number: $port_number"
puts ""

#
# Cleaned up files for exclusive control of remote console
#
file mkdir $server_root/isc_remote
file delete -force $server_root/isc_remote/1
file delete -force $server_root/isc_remote/2
file delete -force $server_root/isc_remote/3
file delete -force $server_root/isc_remote/4
file delete -force $server_root/isc_remote/5
file delete -force $server_root/isc_remote/6
file delete -force $server_root/isc_remote/7
file delete -force $server_root/isc_remote/8
file delete -force $server_root/isc_remote/9

socket -server add_a_server $port_number

vwait forever

