Adding user session check to exec.cgi

xmlapi/exec.cgi

@@ -1,6 +1,8 @@
 #!/bin/tclsh
 
 load tclrega.so
+source querystring.tcl
+source session.tcl
 
 proc toString { str } {
   set map {
@@ -22,22 +24,26 @@ puts "Content-Type: text/plain"
 puts "Access-Control-Allow-Origin: *"
 puts ""
 
-
-if { [catch {
-  set content [read stdin]
-  array set script_result [rega_script $content]
-
-  set first 1
-  set result "\{\n"
-  foreach name [array names script_result] {
-    if { 1 != $first } { append result ",\n" } { set first 0 }
-    set value $script_result($name)
-    append result "  [toString $name]: [toString $value]"
+if {[info exists sid] && [check_session $sid]} {
+  if { [catch {
+    set content [read stdin]
+    array set script_result [rega_script $content]
+
+    set first 1
+    set result "\{\n"
+    foreach name [array names script_result] {
+      if { 1 != $first } { append result ",\n" } { set first 0 }
+      set value $script_result($name)
+      append result "  [toString $name]: [toString $value]"
+    }
+    append result "\n\}"
+
+    puts $result
+
+  } errorMessage] } {
+    puts $errorMessage
   }
-  append result "\n\}"
-
-  puts $result
 
-} errorMessage] } {
-  puts $errorMessage
+} else {
+    puts "{error: no session}"
 }

xmlapi/querystring.tcl

@@ -0,0 +1,9 @@
+catch {
+  set input $env(QUERY_STRING)
+  set pairs [split $input &]
+  foreach pair $pairs {
+    if {0 != [regexp "^(\[^=]*)=(.*)$" $pair dummy varname val]} {
+      set $varname $val
+    }
+  }
+}

xmlapi/session.tcl

@@ -0,0 +1,13 @@
+#!/bin/tclsh
+
+load tclrega.so
+
+proc check_session sid {
+    if {[regexp {@([0-9a-zA-Z]{10})@} $sid all sidnr]} {
+        set res [lindex [rega_script "Write(system.GetSessionVarStr('$sidnr'));"] 1]
+        if {$res != ""} {
+            return 1
+        }
+    }
+    return 0
+}