1############################################################################# 2## 3#W server.g The SCSCP package Alexander Konovalov 4#W Steve Linton 5## 6############################################################################# 7 8# additional procedures to turn tracing on/off 9 10InstallSCSCPprocedure( "SCSCPStartTracing", SCSCPStartTracing, 11 "To turn on tracing mode on the server and save events to specified filename without extension", 12 1, 1 : force ); 13InstallSCSCPprocedure( "SCSCPStopTracing", SCSCPStopTracing, 14 "To turn off tracing mode on the server", 15 0, 0 : force ); 16 17############################################################################# 18# 19# RunSCSCPserver( <server>, <port> ) 20# 21# The 1st argument is the name of the server, e.g. "localhost" or 22# "servername.somewhere.domain", the 2nd is the port number as an integer. 23# The 1st argument may also be 'true' to listen to all network interfaces 24# or 'false' to bind the server strictly to "localhost". 25# 26InstallGlobalFunction( RunSCSCPserver, function( server, port ) 27 28local socket, lookup, bindaddr, addr, res, disconnect, socket_descriptor, 29 stream, objrec, pos, call_id_value, atp, callinfo, output, 30 return_cookie, return_nothing, return_deferred, cookie, omtext, 31 localstream, callresult, responseresult, errormessage, str, session_id, 32 welcome_string, session_cookies, client_scscp_version, pos1, pos2, 33 rt1, rt2, debuglevel, servername, hostname, todo, token; 34 35if ARCH_IS_UNIX() then 36 Append( SCSCPserviceDescription, Concatenation( " on ", CurrentTimestamp() ) ); 37fi; 38 39# forbid opportunity to send plain GAP code to the server 40Unbind(OMsymRecord.cas); 41 42ReadPackage("scscp", "lib/errors.g"); # to patch ErrorInner in the server mode 43 44SCSCPserverMode := true; 45SCSCPserverAddress := server; 46SCSCPserverPort := port; 47socket := IO_socket( IO.PF_INET, IO.SOCK_STREAM, "tcp" ); 48if ARCH_IS_UNIX() then 49 # on Windows, the following line allows to run more than one server 50 # at the same port, and the earlier started server will get the request. 51 IO_setsockopt( socket, IO.SOL_SOCKET,IO.SO_REUSEADDR, "xxxx" ); 52fi; 53if server = true then 54 bindaddr := "\000\000\000\000"; 55 server := "0.0.0.0"; 56 hostname := Hostname(); 57 servername := Concatenation( hostname, ".", server ); 58 SCSCPserverAddress := Hostname(); 59else 60 if server = false then 61 server := "localhost"; 62 SCSCPserverAddress := "localhost"; 63 fi; 64 servername := server; 65 hostname := server; 66 lookup := IO_gethostbyname( server ); 67 if lookup = fail then 68 return rec( socket := fail, 69 errormsg := "RunSCSCPserver: cannot find hostname" ); 70 fi; 71 bindaddr := lookup.addr[1]; 72fi; 73 74res := IO_bind( socket, IO_make_sockaddr_in( bindaddr, port ) ); 75if res = fail then 76 Print( "Error: ", LastSystemError(), "\n" ); 77 IO_close( socket ); 78 # Printing to *errout* so we are able to see this 79 # even if the output was redirected 80 PrintTo( "*errout*", 81 "\n******************************************\n", 82 "failed to start SCSCP server at port ", port, 83 "\n******************************************\n\n" ); 84 # Trick to be able to quit GAP from gapscscp.sh script 85 if not IsBoundGlobal( "SCSCPserverStatus" ) then 86 BindGlobal( "SCSCPserverStatus" , fail ); 87 fi; 88 return; 89else 90 welcome_string:= Concatenation( 91 "<?scscp service_name=\"GAP\" service_version=\"", 92 GAPInfo.Version, "\" service_id=\"", servername, ":", 93 String(port), ":", String(IO_getpid()), 94 "\" scscp_versions=\"1.0 1.1 1.2 1.3\" ?>"); 95 Print( "#I Ready to accept TCP/IP connections at ", 96 server, ":", port, " ... \n" ); 97 IO_listen( socket, SCSCPqueueLength ); # Allow a backlog of 5 connections 98 session_cookies := []; 99 repeat # until false: this is the outer infinite loop 100 disconnect := false; 101 # cleanup of cookies from previous session and resetting their list 102 # comment out next four lines to disable this feature 103 # for cookie in session_cookies do 104 # UnbindGlobal( cookie ); 105 # od; 106 # session_cookies := []; 107 repeat # until disconnect: this loop is a signle SCSCP session 108 # We accept connections from everywhere 109 Info(InfoSCSCP, 1, "Waiting for new client connection at ", 110 server, ":", port, " ..." ); 111 addr := IO_MakeIPAddressPort( "0.0.0.0", 0 ); 112 if IN_SCSCP_TRACING_MODE then SCSCPTraceSuspendThread(); fi; 113 socket_descriptor := IO_accept( socket, addr ); 114 if IN_SCSCP_TRACING_MODE then SCSCPTraceRunThread(); fi; 115 Info(InfoSCSCP, 1, "Got connection from ", List(addr{[5..8]},INT_CHAR) ); 116 stream := InputOutputTCPStream( socket_descriptor ); 117 Info(InfoSCSCP, 1, "Stream created ..."); 118 Info(InfoSCSCP, 1, "Sending connection initiation message" ); 119 Info(InfoSCSCP, 2, welcome_string ); 120 WriteLine( stream, welcome_string ); 121 client_scscp_version := ReadLine( stream ); 122 if client_scscp_version=fail then 123 Info(InfoSCSCP, 1, "Client disconnected without sending version" ); 124 CloseStream( stream ); 125 continue; 126 fi; 127 if InfoLevel(InfoSCSCP)>0 then 128 Print( "#I Client replied with ", client_scscp_version ); 129 fi; 130 pos1 := PositionNthOccurrence(client_scscp_version,'\"',1); 131 pos2 := PositionNthOccurrence(client_scscp_version,'\"',2); 132 if pos1 = fail or pos2 = fail then 133 Info(InfoSCSCP, 1, "Rejecting the client because of improper message ", 134 client_scscp_version ); 135 CloseStream( stream ); 136 continue; 137 else 138 client_scscp_version := client_scscp_version{[ pos1+1 .. pos2-1 ]}; 139 fi; 140 if not client_scscp_version in [ "1.0", "1.1", "1.2", "1.3" ] then 141 Info(InfoSCSCP, 1, "Rejecting the client because of non supported version ", 142 client_scscp_version ); 143 WriteLine( stream, Concatenation( "<?scscp quit reason=\"non supported version ", 144 client_scscp_version, "\" ?>" ) ); 145 else 146 SCSCP_VERSION := client_scscp_version; 147 Info(InfoSCSCP, 1, "Confirming version ", SCSCP_VERSION, " to the client ..."); 148 WriteLine( stream, Concatenation( "<?scscp version=\"", SCSCP_VERSION, "\" ?>" ) ); 149 150 # now handshaking is finished and read-evaluate-response loop is started 151 repeat 152 Info(InfoSCSCP, 1, "Waiting for OpenMath object ..."); 153 # currently the timeout is 3600 seconds = 1 hour 154 if IN_SCSCP_TRACING_MODE then SCSCPTraceSuspendThread(); fi; 155 callresult:=CALL_WITH_CATCH( IO_Select, 156 [ [ stream![1] ], [ ], [ ], [ ], 60*60, 0 ] ); 157 if IN_SCSCP_TRACING_MODE then SCSCPTraceRunThread(); fi; 158 if not callresult[1] then 159 disconnect:=true; 160 break; 161 fi; 162 163 Info(InfoSCSCP, 1, "Retrieving and evaluating ..."); 164 rt1 := Runtime(); 165 callresult:=CALL_WITH_CATCH( OMGetObjectWithAttributes, [ stream ] ); 166 rt2 := Runtime(); 167 Info(InfoSCSCP, 1, "Evaluation completed"); 168 169 objrec := callresult[2]; # can be record, fail or list of strings 170 171 if objrec = fail then 172 Info(InfoSCSCP, 1, "Connection was closed by the client"); 173 disconnect:=true; 174 break; 175 fi; 176 # We detect the case when objrec is not fail and not record 177 # to convert it to the standard objrec format. This happens 178 # when error message is returned 179 if not IsRecord(objrec) then 180 objrec := rec( object := objrec, 181 attributes := OMParseXmlObj(OMTempVars.OMATTR) ); 182 fi; 183 184 pos := PositionProperty( objrec.attributes, atp -> atp[1]="call_id" ); 185 # the call_id is mandatory, however, we still can do something without it 186 if pos<>fail then 187 call_id_value := objrec.attributes[pos][2]; 188 else 189 call_id_value := "N/A"; 190 fi; 191 192 if ForAny( objrec.attributes, atp -> atp[1]="option_return_deferred" ) then 193 return_deferred := true; 194 else 195 return_deferred := false; 196 fi; 197 198 if ForAny( objrec.attributes, atp -> atp[1]="option_return_cookie" ) then 199 return_cookie := true; 200 else 201 return_cookie := false; 202 if ForAny( objrec.attributes, atp -> atp[1]="option_return_nothing" ) then 203 return_nothing := true; 204 else 205 return_nothing := false; 206 fi; 207 fi; 208 pos := PositionProperty( objrec.attributes, atp -> atp[1]="option_debuglevel" ); 209 if pos<>fail then 210 debuglevel := objrec.attributes[pos][2]; 211 else 212 debuglevel := 0; 213 fi; 214 215 # we gather in callinfo additional information about the 216 # procedure call: now it is only call_id, in the future we 217 # will add used memory, runtime, etc. 218 callinfo:= [ [ "call_id", call_id_value ] ]; 219 if debuglevel > 0 then 220 Add( callinfo, [ "info_runtime", rt2-rt1 ] ); 221 fi; 222 if debuglevel > 1 then 223 Add( callinfo, [ "info_memory", 1024*MemoryUsageByGAPinKbytes() ] ); 224 fi; 225 if debuglevel > 2 then 226 Add( callinfo, [ "info_message", 227 Concatenation( "Memory usage for the result is ", 228 String( MemoryUsage( objrec.object ) ), " bytes" ) ] ); 229 fi; 230 231 if not callresult[1] or ( IsBound( objrec.is_error) and (objrec.is_error) ) then 232 # preparations to send an error message to the client 233 IN_SCSCP_BINARY_MODE := false; 234 if InfoLevel( InfoSCSCP ) > 0 then 235 Print( "#I Sending error message: ", objrec.object, "\n" ); 236 fi; 237 if objrec.object[1] = "OpenMathError: " then 238 errormessage := [ 239 OMPlainString( Concatenation( "<OMS cd=\"", objrec.object[4], 240 "\" name=\"", objrec.object[6], "\"/>" ) ), 241 "error", objrec.object[2] ]; 242 else 243 # glue together error messages into a single string 244 errormessage := [ Concatenation( servername, ":", String(port), " reports : ", 245 Concatenation( List( objrec.object, String ) ) ), 246 "scscp1", "error_system_specific" ]; 247 fi; 248 249 if InfoLevel( InfoSCSCP ) > 2 then 250 Print("#I Composing procedure_terminated message: \n"); 251 omtext:=""; 252 localstream := OutputTextString( omtext, true ); 253 OMPutProcedureTerminated( localstream, 254 rec( object:=errormessage[1], 255 attributes:=callinfo ), 256 errormessage[2], 257 errormessage[3] ); 258 Print(omtext, "#I Total length ", Length(omtext), " characters \n"); 259 fi; 260 261 responseresult := CALL_WITH_CATCH( OMPutProcedureTerminated, 262 [ stream, 263 rec( object:=errormessage[1], 264 attributes:=callinfo ), 265 errormessage[2], 266 errormessage[3] ] ); 267 268 if responseresult[1] then 269 Info(InfoSCSCP, 1, "procedure_terminated message sent, closing connection ..."); 270 else 271 Info(InfoSCSCP, 1, "client already disconnected, closing connection on server side ..."); 272 fi; 273 disconnect:=true; 274 break; 275 fi; 276 277 if return_deferred then 278 todo := objrec.object; 279 objrec.object := true; 280 fi; 281 282 Info( InfoSCSCP, 2, "call_id ", call_id_value, " : sending to client ", objrec.object ); 283 284 if return_cookie then 285 cookie := TemporaryGlobalVarName( Concatenation( "TEMPVarSCSCP", RandomString(8) ) ); 286 ASS_GVAR( cookie, objrec.object ); 287 if ISBOUND_GLOBAL( cookie ) then 288 Info( InfoSCSCP, 2, "Result stored in the global variable ", cookie ); 289 else 290 Error( "Failed to store result in the global variable ", cookie, "\n" ); 291 fi; 292 # should the cookie be destroyed after the session? 293 if SCSCP_STORE_SESSION_MODE then 294 Add( session_cookies, cookie ); 295 fi; 296 output := rec( object := RemoteObject( cookie, hostname, port ), 297 attributes := callinfo ); 298 elif return_nothing then 299 output := rec( attributes:= callinfo ); 300 else 301 output := rec( object := objrec.object, attributes:= callinfo ); 302 fi; 303 304 if InfoLevel( InfoSCSCP ) > 2 then 305 Print("#I Composing procedure_completed message: \n"); 306 omtext:=""; 307 localstream := OutputTextString( omtext, true ); 308 CALL_WITH_CATCH( OMPutProcedureCompleted, [ localstream, output ] ); 309 if IN_SCSCP_BINARY_MODE then 310 localstream:=InputTextString( omtext ); 311 token:=ReadByte( localstream ); 312 while token <> fail do 313 Print( EnsureCompleteHexNum( HexStringInt( token ) ) ); 314 token:=ReadByte( localstream ); 315 od; 316 Print("\n#I Total length ", Length(omtext), " bytes \n"); 317 else 318 Print(omtext, "#I Total length ", Length(omtext), " characters \n"); 319 fi; 320 fi; 321 322 responseresult := CALL_WITH_CATCH( OMPutProcedureCompleted, [ stream, output ] ); 323 324 if not responseresult[1] then 325 Info(InfoSCSCP, 1, "client already disconnected, closing connection on server side ..."); 326 disconnect:=true; 327 break; 328 fi; 329 330 if return_deferred then 331 # actual work; no result will be returned 332 todo := OMParseXmlObj( todo ); 333 Info(InfoSCSCP, 1, "Deferred procedure call result : ", todo); 334 fi; 335 336 until false; 337 fi; 338 Info(InfoSCSCP, 1, "Closing stream ..."); 339 # socket descriptor will be closed here 340 CloseStream( stream ); 341 until disconnect; # end of a single SCSCP session 342 until false; # end of the outer infinite loop 343fi; 344end); 345 346########################################################################### 347## 348#E 349## 350