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