diff --git a/lib/openmath.g b/lib/openmath.g index 2867874..5219b36 100644 --- a/lib/openmath.g +++ b/lib/openmath.g @@ -6,7 +6,7 @@ ############################################################################# if not CompareVersionNumbers( GAPInfo.Version, "4.5.0") then - CALL_WITH_CATCH := CallFuncList; + CALL_WITH_CATCH := CallFuncList; fi; SCSCP_UNBIND_MODE := false; @@ -45,8 +45,8 @@ InstallGlobalFunction( SCSCP_STORE_PERSISTENT, x -> x[1] ); # InstallGlobalFunction( SCSCP_UNBIND, function( varnameasstring ) -UnbindGlobal( varnameasstring[1] ); -return not IsBoundGlobal( varnameasstring[1] ); + UnbindGlobal( varnameasstring[1] ); + return not IsBoundGlobal( varnameasstring[1] ); end); @@ -56,30 +56,30 @@ end); # InstallGlobalFunction( SCSCP_GET_ALLOWED_HEADS, function( x ) -# the function should have an argument, which in this case will be an -# empty list, since 'get_allowed_heads' has no arguments -local range, cd, name, omstr; -if x <> [] then - Print( "WARNING: get_allowed_heads has no arguments, but called with argument ", x, - " which will be ignored!\n"); -fi; -omstr:="\n"; -Append( omstr, "\n" ); -# we may eventually have more than one transient CD, then the loop will be uncommented -if SCSCPserverAcceptsOnlyTransientCD then - range := [ "scscp_transient_1" ]; -else - range := RecNames(OMsymRecord); -fi; -for cd in range do - for name in RecNames(OMsymRecord.(cd)) do - if OMsymRecord.(cd).(name) <> fail then - Append( omstr, Concatenation( "\n" ) ); - fi; - od; -od; -Append( omstr, "" ); -return OMPlainString( omstr ); + # the function should have an argument, which in this case will be an + # empty list, since 'get_allowed_heads' has no arguments + local range, cd, name, omstr; + if x <> [] then + Print( "WARNING: get_allowed_heads has no arguments, but called with argument ", x, + " which will be ignored!\n"); + fi; + omstr:="\n"; + Append( omstr, "\n" ); + # we may eventually have more than one transient CD, then the loop will be uncommented + if SCSCPserverAcceptsOnlyTransientCD then + range := [ "scscp_transient_1" ]; + else + range := RecNames(OMsymRecord); + fi; + for cd in range do + for name in RecNames(OMsymRecord.(cd)) do + if OMsymRecord.(cd).(name) <> fail then + Append( omstr, Concatenation( "\n" ) ); + fi; + od; + od; + Append( omstr, "" ); + return OMPlainString( omstr ); end); @@ -89,15 +89,15 @@ end); # InstallGlobalFunction( SCSCP_IS_ALLOWED_HEAD, function( x ) -local tran, s, symb, t; -if IsBound( OMsymRecord.(x[1]) ) then - if IsBound( OMsymRecord.(x[1]).(x[2]) ) then - if OMsymRecord.(x[1]).(x[2]) <> fail then - return true; + local tran, s, symb, t; + if IsBound( OMsymRecord.(x[1]) ) then + if IsBound( OMsymRecord.(x[1]).(x[2]) ) then + if OMsymRecord.(x[1]).(x[2]) <> fail then + return true; + fi; + fi; fi; - fi; -fi; -return false; + return false; end); @@ -107,19 +107,19 @@ end); # InstallGlobalFunction( SCSCP_GET_SERVICE_DESCRIPTION, function( x ) -local omstr; -# the function should have an argument, which in this case will be an -# empty list, since 'get_allowed_heads' has no arguments -if x <> [] then - Print( "WARNING: get_service_description has no arguments, but called with argument ", x, - " which will be ignored!\n"); -fi; -omstr:="\n\n"; -Append( omstr, Concatenation("", SCSCPserviceName, "\n" ) ); -Append( omstr, Concatenation("", SCSCPserviceVersion, "\n" ) ); -Append( omstr, Concatenation("", SCSCPserviceDescription, "\n" ) ); -Append( omstr, "" ); -return OMPlainString( omstr ); + local omstr; + # the function should have an argument, which in this case will be an + # empty list, since 'get_allowed_heads' has no arguments + if x <> [] then + Print( "WARNING: get_service_description has no arguments, but called with argument ", x, + " which will be ignored!\n"); + fi; + omstr:="\n\n"; + Append( omstr, Concatenation("", SCSCPserviceName, "\n" ) ); + Append( omstr, Concatenation("", SCSCPserviceVersion, "\n" ) ); + Append( omstr, Concatenation("", SCSCPserviceDescription, "\n" ) ); + Append( omstr, "" ); + return OMPlainString( omstr ); end); @@ -129,26 +129,26 @@ end); # InstallGlobalFunction( SCSCP_GET_TRANSIENT_CD, function( x ) -local omstr, procname; -if not IsBound( OMsymRecord.(x[1]) ) then - Error("no_such_transient_cd"); -else - omstr:="\nscscp_transient_1\n"; - Append( omstr, Concatenation( "", DateISO8601(), "\n" ) ); - Append( omstr, Concatenation( "", DateISO8601(), "\n" ) ); - Append( omstr, Concatenation( "", "0", "\n" ) ); - Append( omstr, Concatenation( "", "0", "\n" ) ); - Append( omstr, "private\n" ); - Append( omstr, "This is a transient CD for the GAP SCSCP service\n" ); - for procname in RecNames( OMsymRecord.(x[1]) ) do - Append( omstr, Concatenation( "\n", "", procname, "\n" ) ); - Append( omstr, Concatenation( "", - SCSCPtransientCDs.(x[1]).(procname).Description, - "\n\n" ) ); - od; -fi; -Append( omstr, "" ); -return OMPlainString( omstr ); + local omstr, procname; + if not IsBound( OMsymRecord.(x[1]) ) then + Error("no_such_transient_cd"); + else + omstr:="\nscscp_transient_1\n"; + Append( omstr, Concatenation( "", DateISO8601(), "\n" ) ); + Append( omstr, Concatenation( "", DateISO8601(), "\n" ) ); + Append( omstr, Concatenation( "", "0", "\n" ) ); + Append( omstr, Concatenation( "", "0", "\n" ) ); + Append( omstr, "private\n" ); + Append( omstr, "This is a transient CD for the GAP SCSCP service\n" ); + for procname in RecNames( OMsymRecord.(x[1]) ) do + Append( omstr, Concatenation( "\n", "", procname, "\n" ) ); + Append( omstr, Concatenation( "", + SCSCPtransientCDs.(x[1]).(procname).Description, + "\n\n" ) ); + od; + fi; + Append( omstr, "" ); + return OMPlainString( omstr ); end); @@ -158,22 +158,22 @@ end); # InstallGlobalFunction( SCSCP_GET_SIGNATURE, function( x ) -local omstr; -if not IsBound( OMsymRecord.(x[1]) ) then - Error("no_such_transient_cd"); -else - if not IsBound( OMsymRecord.(x[1]).(x[2]) ) then - Error("no_such_symbol"); + local omstr; + if not IsBound( OMsymRecord.(x[1]) ) then + Error("no_such_transient_cd"); else - omstr:="\n\n"; - Append( omstr, Concatenation( "\n" ) ); - Append( omstr, Concatenation( OMString( SCSCPtransientCDs.(x[1]).(x[2]).Minarg : noomobj ), "\n" ) ); - Append( omstr, Concatenation( OMString( SCSCPtransientCDs.(x[1]).(x[2]).Maxarg : noomobj ), "\n" ) ); - Append( omstr, "\n" ); - Append( omstr, "" ); - return OMPlainString( omstr ); - fi; -fi; + if not IsBound( OMsymRecord.(x[1]).(x[2]) ) then + Error("no_such_symbol"); + else + omstr:="\n\n"; + Append( omstr, Concatenation( "\n" ) ); + Append( omstr, Concatenation( OMString( SCSCPtransientCDs.(x[1]).(x[2]).Minarg : noomobj ), "\n" ) ); + Append( omstr, Concatenation( OMString( SCSCPtransientCDs.(x[1]).(x[2]).Maxarg : noomobj ), "\n" ) ); + Append( omstr, "\n" ); + Append( omstr, "" ); + return OMPlainString( omstr ); + fi; + fi; end); @@ -182,13 +182,13 @@ end); ## Extending global record OMsymRecord previously created in OpenMath package ## OMsymRecord.scscp1 := rec( - procedure_call := x -> x[1], # x is already converted from OM to GAP - procedure_completed := - function(x); - if IsBound(x[1]) then - return x[1]; + procedure_call := x -> x[1], # x is already converted from OM to GAP + procedure_completed := + function(x); + if IsBound(x[1]) then + return x[1]; else # when no object is returned - return "procedure completed"; + return "procedure completed"; fi; end, procedure_terminated := x -> x[1], @@ -207,7 +207,7 @@ OMsymRecord.scscp1 := rec( error_CAS := "error_CAS" ); -OMsymRecord.scscp2 := rec( +OMsymRecord.scscp2 := rec( store_session := SCSCP_STORE_SESSION, store_persistent := SCSCP_STORE_PERSISTENT, retrieve := SCSCP_RETRIEVE, @@ -218,11 +218,11 @@ OMsymRecord.scscp2 := rec( get_transient_cd := SCSCP_GET_TRANSIENT_CD, get_signature := SCSCP_GET_SIGNATURE ); - + OMsymRecord.meta := rec( - CDName := x -> x[1] + CDName := x -> x[1] ); - + ############################################################################# ## @@ -232,102 +232,57 @@ OMsymRecord.meta := rec( ## Takes precisely one object off (using PipeOpenMathObject) ## and puts it into a string. ## From there the OpenMath object is turned into a record r with fields -## r.object, containing the corresponding GAP object, and r.attributes, -## which is a list of pairs [ name, value ], for example +## r.object, containing the corresponding GAP object, and r.attributes, +## which is a list of pairs [ name, value ], for example ## [ ["call_id", "user007" ], ["option_runtime", 300000] ] ## This is a counterpart of the function OMGetObject from OpenMath package . ## +## TODO: This should be somehow replaced by OMGetObject from the OpenMath package InstallGlobalFunction( OMGetObjectWithAttributes, function( stream ) - local return_tree, - fromgap, # string - firstbyte, - gap_obj, - success, # whether PipeOpenMathObject worked - readline; - - if IsClosedStream( stream ) then - Error( "closed stream" ); - elif IsEndOfStream( stream ) then - Error( "end of stream" ); - fi; - - if ValueOption("return_tree") <> fail then - return_tree := true; - else - return_tree := false; + local ReadUntil, tree; + + ReadUntil := function(stream, string) + local readline; + repeat + readline := ReadLine(stream); + if readline = fail then + return fail; + fi; + NormalizeWhitespace( readline ); + if Length(readline) > 0 then + Info( InfoSCSCP, 2, readline ); + fi; + until readline = string; + return true; + end; + + if IsClosedStream(stream) then + Error(" is closed"); + elif IsEndOfStream(stream) then + Error(" is in state end of stream" ); fi; # read new line until - repeat - readline:=ReadLine(stream); - if readline=fail then - return fail; - fi; - NormalizeWhitespace( readline ); - if Length( readline ) > 0 then - Info( InfoSCSCP, 2, readline ); - fi; - until readline= ""; - - firstbyte := ReadByte(stream); - - if firstbyte = 24 then - # Reading binary encoding => set reply mode to binary - IN_SCSCP_BINARY_MODE:=true; - gap_obj := GetNextObject( stream, firstbyte ); - gap_obj := OMParseXmlObj( gap_obj.content[1] ); - return rec( object := gap_obj, attributes := OMParseXmlObj( OMTempVars.OMATTR ) ); - else - - if firstbyte = fail then - Info( InfoSCSCP, 2, "OpenMath object not retrieved by PipeOpenMathObject" ); - return fail; - fi; - - # Reading XML encoding => set reply mode to XML - IN_SCSCP_BINARY_MODE:=false; - fromgap := ""; - # Get one OpenMath object from 'stream' and put into 'fromgap', - # using PipeOpenMathObject - - success := PipeOpenMathObject( stream, fromgap, firstbyte ); - - if success <> true then - Info( InfoSCSCP, 2, "OpenMath object not retrieved by PipeOpenMathObject" ); - return fail; - fi; - - # Now 'fromgap' is the string with OpenMath encoding - - if InfoLevel( InfoSCSCP ) > 2 then - Print("#I Received message: \n"); - Print( fromgap ); - Print( "\n" ); - fi; - - # read new line until - repeat - readline:=ReadLine(stream); - if readline=fail then - return fail; - fi; - NormalizeWhitespace( readline ); - if Length( readline ) > 0 then - Info( InfoSCSCP, 2, readline ); - fi; - until readline= ""; - - # convert the OpenMath string into a Gap object using an appropriate - # function - - if return_tree then - return OMgetObjectXMLTreeWithAttributes( fromgap : return_tree ); - else - return OMgetObjectXMLTreeWithAttributes( fromgap ); - fi; + # TODO: How to switch binary/nonbinary? + # previously this code had this switch: + # IN_SCSCP_BINARY_MODE:=true; + # IN_SCSCP_BINARY_MODE:=false; + # (again state in global variables...) + # TODO: Handle attributes, they seem to end up + # in temp vars for some reason, are then + # extracted to attributes in the returned record? + # TODO: Need to return fail if ReadUntil fails + + ReadUntil(""); + tree := OMGetTree(stream); + ReadUntil(""); + + if ValueOption("return_tree") = fail then + return OMParseXmlObj( tree.content[1] ); fi; -end ); + return tree; +end); ############################################################################# @@ -337,18 +292,25 @@ end ); ## This is a counterpart of the OpenMath function OMgetObjectXMLTree ## InstallGlobalFunction( OMgetObjectXMLTreeWithAttributes, - function ( string ) - local return_tree, return_deferred, node, attrs, t, obj, pos, name; - +function ( string ) + local return_tree, + return_deferred, + node, + attrs, + t, + obj, + pos, + name; + if ValueOption("return_tree") <> fail then return_tree := true; else - return_tree := false; + return_tree := false; fi; OMTempVars.OMBIND := rec( ); OMTempVars.OMREF := rec( ); - + # This is the difference from OMgetObjectXMLTree OMTempVars.OMATTR := rec( ); @@ -357,204 +319,150 @@ InstallGlobalFunction( OMgetObjectXMLTreeWithAttributes, node.content := Filtered( node.content, OMIsNotDummyLeaf ); # Print( "ParseTreeXMLString( string ) = ", node.content, "\n" ); - attrs := List( Filtered( node.content[1].content, t -> t.name = "OMATP" ), OMParseXmlObj ); - + if Length(attrs)=1 then - attrs:=attrs[1]; + attrs:=attrs[1]; fi; - + # At this point we already know attributes BEFORE the the real computation is started. # This allows us to know in advance which kind of return (object/cookie/tree) # is expected, and which runtime and memory limits were specified, if any. - # Now we will check that this is really procedure_call message and that - # the procedure is allowed, that is, it is from scscp{1,2} or scscp_transient_X CD - - if SCSCPserverMode then - - SCSCP_UNBIND_MODE := false; + # Now we will check that this is really procedure_call message and that + # the procedure is allowed, that is, it is from scscp{1,2} or scscp_transient_X CD + + if SCSCPserverMode then + SCSCP_UNBIND_MODE := false; SCSCP_STORE_SESSION_MODE := true; - - pos:=PositionProperty( node.content[1].content, r -> r.name="OMA"); # expected scscp1.procedure_call - if pos=fail then - return rec( object := [ "Message rejected: it must be a proper scscp1.procedure_call" ], - attributes := attrs, is_error:=true ); - else - node.content[1].content[pos].content := - Filtered( node.content[1].content[pos].content, OMIsNotDummyLeaf ); - if not IsBound( node.content[1].content[pos].content[1] ) or - not IsBound( node.content[1].content[pos].content[1].attributes ) or - not node.content[1].content[pos].content[1].attributes in - [ rec( name := "procedure_call", cd := "scscp1" ), - rec( name := "procedure_completed", cd := "scscp1" ), - rec( name := "procedure_terminated", cd := "scscp1") ] - then - return rec( object := [ "Message rejected because it is not a proper scscp1.procedure_call" ], - attributes := attrs, is_error:=true ); - else - node.content[1].content[pos].content[2].content := - Filtered( node.content[1].content[pos].content[2].content, OMIsNotDummyLeaf ); - if not IsBound( node.content[1].content[pos].content[2].content[1] ) or - not IsBound( node.content[1].content[pos].content[2].content[1].attributes ) or - not IsBound( node.content[1].content[pos].content[2].content[1].attributes.cd ) then - return rec( object := [ "Message rejected because it is not properly formatted" ], - attributes := attrs, is_error:=true ); - elif SCSCPserverAcceptsOnlyTransientCD and - ( Length( node.content[1].content[pos].content[2].content[1].attributes.cd ) < 5 or - not node.content[1].content[pos].content[2].content[1].attributes.cd{[1..5]} = "scscp" ) then - return rec( object := [ - "Message rejected because the procedure ", - node.content[1].content[pos].content[2].content[1].attributes.cd, ".", - node.content[1].content[pos].content[2].content[1].attributes.name, - " is not allowed"], - attributes := attrs, is_error:=true ); - else - # some checks for some particular special procedures might be here - if node.content[1].content[pos].content[2].content[1].attributes.cd = "scscp2" then - name := node.content[1].content[pos].content[2].content[1].attributes.name; - if name = "unbind" then - SCSCP_UNBIND_MODE := true; - elif name = "store_persistent" then - SCSCP_STORE_SESSION_MODE := false; - fi; - fi; - fi; - fi; - fi; - - fi; - - # if the security check is done, we may proceed - - if ForAny( attrs, t -> t[1]="option_return_deferred" ) then - return_deferred := true; - else - return_deferred := false; - fi; - + + pos:=PositionProperty( node.content[1].content, r -> r.name="OMA"); # expected scscp1.procedure_call + if pos=fail then + return rec( object := [ "Message rejected: it must be a proper scscp1.procedure_call" ], + attributes := attrs, is_error:=true ); + else + node.content[1].content[pos].content := + Filtered( node.content[1].content[pos].content, OMIsNotDummyLeaf ); + if not IsBound( node.content[1].content[pos].content[1] ) or + not IsBound( node.content[1].content[pos].content[1].attributes ) or + not node.content[1].content[pos].content[1].attributes in + [ rec( name := "procedure_call", cd := "scscp1" ), + rec( name := "procedure_completed", cd := "scscp1" ), + rec( name := "procedure_terminated", cd := "scscp1") ] + then + return rec( object := [ "Message rejected because it is not a proper scscp1.procedure_call" ], + attributes := attrs, is_error:=true ); + else + node.content[1].content[pos].content[2].content := + Filtered( node.content[1].content[pos].content[2].content, OMIsNotDummyLeaf ); + if not IsBound( node.content[1].content[pos].content[2].content[1] ) or + not IsBound( node.content[1].content[pos].content[2].content[1].attributes ) or + not IsBound( node.content[1].content[pos].content[2].content[1].attributes.cd ) then + return rec( object := [ "Message rejected because it is not properly formatted" ], + attributes := attrs, is_error:=true ); + elif SCSCPserverAcceptsOnlyTransientCD and + ( Length( node.content[1].content[pos].content[2].content[1].attributes.cd ) < 5 or + not node.content[1].content[pos].content[2].content[1].attributes.cd{[1..5]} = "scscp" ) then + return rec( object := [ + "Message rejected because the procedure ", + node.content[1].content[pos].content[2].content[1].attributes.cd, ".", + node.content[1].content[pos].content[2].content[1].attributes.name, + " is not allowed"], + attributes := attrs, is_error:=true ); + else + # some checks for some particular special procedures might be here + if node.content[1].content[pos].content[2].content[1].attributes.cd = "scscp2" then + name := node.content[1].content[pos].content[2].content[1].attributes.name; + if name = "unbind" then + SCSCP_UNBIND_MODE := true; + elif name = "store_persistent" then + SCSCP_STORE_SESSION_MODE := false; + fi; + fi; + fi; + fi; + fi; + fi; + # if the security check is done, we may proceed + if ForAny( attrs, t -> t[1]="option_return_deferred" ) then + return_deferred := true; + else + return_deferred := false; + fi; if return_tree or return_deferred then obj := node.content[1]; else obj := OMParseXmlObj( node.content[1] ); fi; - - # the next check was is a temporary measure to verify that - # attributes were identified properly - - #if OMTempVars.OMATTR <> rec() then - # if OMParseXmlObj( OMTempVars.OMATTR ) <> attrs then - # Error("Attributes were not properly identified:\n", - # "OMParseXmlObj( OMTempVars.OMATTR ) = ", OMParseXmlObj( OMTempVars.OMATTR ), "\n", - # "attrs = ", attrs ); - # fi; - #fi; - return rec( object:=obj, attributes:=attrs ); - end ); - -############################################################################# -## -## OMObjects.OMATTR( node ) -## -## we overwrite the OpenMath function OMObjects.OMATTR with our definition -## (if OMObjects.OMATTR will be called from OpenMath, the OMTempWars.OMATTR -## will be ignored) -## -OMObjects.OMATTR := function ( node ) -OMTempVars.OMATTR:=Filtered( node.content, - function ( x ) - return x.name = "OMATP"; - end )[1]; -node.content := Filtered( node.content, - function ( x ) - return x.name <> "OMATP"; - end ); -return OMParseXmlObj( node.content[1] ); -end; - - -############################################################################# -## -## OMObjects.OMATP( node ) -## -## We add OMObjects.OMATP function to the list of functions OMObjects -## defined as a global variable in the OpenMath package -## -OMObjects.OMATP := function ( node ) -local i; -#DisplayXMLStructure(node); -return List( [1,3..Length(node.content)-1], i -> - [ OMParseXmlObj(node.content[i]), OMParseXmlObj(node.content[i+1]) ] ); -end; - - ############################################################################# ## ## OMObjects.OMR( node ) ## ## This overwrites OMObjects.OMR defined in OpenMath package as ## return OMTempVars.OMREF.(node.attributes.href); -## +## +## FIXME: Move as much as possible of this into the OpenMath package, +## maybe a configurable retrieval mechanism for "foreign" objects? OMObjects.OMR := function ( node ) -local ref, pos1, pos2, pos3, name, server, port; -if IsBound( node.attributes.href ) then - ref := node.attributes.href; - pos1:=PositionSublist( ref, "://" ); - pos2:=PositionNthOccurrence( ref, ':', 2); - if pos1=fail then - # reference to an object within the same OpenMath document - if ref[1]=CHAR_INT(35) then - return OMTempVars.OMREF.(ref{[2..Length(ref)]}); - else - Error( "OpenMath reference: the first symbol must be ", CHAR_INT(35), "\n" ); - fi; - elif pos2=fail then - # reference to an object in a file - Error("References to files are not implemented yet"); - else - # reference to a remote object - if not ref{[1..pos1+2]} = "scscp://" then - Error("Can not parse the reference ", ref, "\n"); - fi; - pos3 := PositionNthOccurrence( ref, '/', 3); - server:=ref{[pos1+3..pos2-1]}; - port:=Int(ref{[pos2+1..pos3-1]}); - name := ref{[pos3+1..Length(ref)]}; - if SCSCPserverMode then - # check that the object is on the same server - if [server,port]=[SCSCPserverAddress,SCSCPserverPort] then - if IsBoundGlobal( name ) and - Length( name ) > 12 and - StartsWith( name, "TEMPVarSCSCP" ) then - if SCSCP_UNBIND_MODE then - SCSCP_UNBIND_MODE := false; - return name; - else - return EvalString( name ); - fi; + local ref, pos1, pos2, pos3, name, server, port; + if IsBound( node.attributes.href ) then + ref := node.attributes.href; + pos1:=PositionSublist( ref, "://" ); + pos2:=PositionNthOccurrence( ref, ':', 2); + if pos1=fail then + # reference to an object within the same OpenMath document + if ref[1]=CHAR_INT(35) then + return OMTempVars.OMREF.(ref{[2..Length(ref)]}); + else + Error( "OpenMath reference: the first symbol must be ", CHAR_INT(35), "\n" ); + fi; + elif pos2=fail then + # reference to an object in a file + Error("References to files are not implemented yet"); else - Error( "Client request refers to an unbound variable ", node.attributes.href, "\n"); - fi; - else # for a "foreign" object - return EvaluateBySCSCP( "retrieve", [ name ], server, port ).object; - fi; - else # in the client's mode - return RemoteObject( node.attributes.href, server, port ); + # reference to a remote object + if not ref{[1..pos1+2]} = "scscp://" then + Error("Can not parse the reference ", ref, "\n"); + fi; + pos3 := PositionNthOccurrence( ref, '/', 3); + server:=ref{[pos1+3..pos2-1]}; + port:=Int(ref{[pos2+1..pos3-1]}); + name := ref{[pos3+1..Length(ref)]}; + if SCSCPserverMode then + # check that the object is on the same server + if [server,port]=[SCSCPserverAddress,SCSCPserverPort] then + if IsBoundGlobal( name ) and + Length( name ) > 12 and + StartsWith( name, "TEMPVarSCSCP" ) then + if SCSCP_UNBIND_MODE then + SCSCP_UNBIND_MODE := false; + return name; + else + return EvalString( name ); + fi; + else + Error( "Client request refers to an unbound variable ", node.attributes.href, "\n"); + fi; + else # for a "foreign" object + return EvaluateBySCSCP( "retrieve", [ name ], server, port ).object; + fi; + else # in the client's mode + return RemoteObject( node.attributes.href, server, port ); + fi; + fi; + else + Error( "OpenMath reference: only href is supported !\n"); fi; - fi; -else - Error( "OpenMath reference: only href is supported !\n"); -fi; -end; +end; ############################################################################# ## ## OMPutProcedureCall ( stream, proc_name, objrec : cd:=cdname ) -## +## ## The first argument is a stream ## The second argument is procedure name as a string. ## The third is a record similar to those returned by @@ -566,164 +474,164 @@ end; ## InstallGlobalFunction( OMPutProcedureCall, function( stream, proc_name, objrec ) -local writer, cdname, debug_option, has_attributes, attr, nameandargs; -if IN_SCSCP_BINARY_MODE then - writer:=OpenMathBinaryWriter(stream); -else - writer:=OpenMathXMLWriter(stream); -fi; -if IsClosedStream( stream ) then - Error( "OMPutProcedureCall: the 1st argument must be an open stream \n" ); -fi; + local writer, cdname, debug_option, has_attributes, attr, nameandargs; + if IN_SCSCP_BINARY_MODE then + writer:=OpenMathBinaryWriter(stream); + else + writer:=OpenMathXMLWriter(stream); + fi; + if IsClosedStream( stream ) then + Error( "OMPutProcedureCall: the 1st argument must be an open stream \n" ); + fi; -if IsBound( objrec.object ) and not IsList( objrec.object ) then - Error( "OMPutProcedureCall: in the 3nd argument must be a list \n" ); -fi; + if IsBound( objrec.object ) and not IsList( objrec.object ) then + Error( "OMPutProcedureCall: in the 3nd argument must be a list \n" ); + fi; -if IsOutputTextStream( stream ) then - SetPrintFormattingStatus( stream, false ); -fi; + if IsOutputTextStream( stream ) then + SetPrintFormattingStatus( stream, false ); + fi; -if ValueOption("cd") <> fail then - cdname := ValueOption("cd"); - if cdname="" then - cdname := "scscp_transient_1"; - fi; -else - cdname := "scscp_transient_1"; -fi; + if ValueOption("cd") <> fail then + cdname := ValueOption("cd"); + if cdname="" then + cdname := "scscp_transient_1"; + fi; + else + cdname := "scscp_transient_1"; + fi; -if ValueOption("debuglevel") <> fail then - debug_option := ValueOption("debuglevel"); -else - debug_option := 0; -fi; + if ValueOption("debuglevel") <> fail then + debug_option := ValueOption("debuglevel"); + else + debug_option := 0; + fi; -OMIndent := 0; -if IN_SCSCP_TRACING_MODE then SCSCPTraceSendMessage( stream![3][1] ); fi; -WriteLine( stream, "" ); -OMPutOMOBJ( writer ); -if IsBound(objrec.attributes) and Length(objrec.attributes)>0 then - has_attributes:=true; - OMPutOMATTR( writer ); - OMPutOMATP( writer ); - for attr in objrec.attributes do - OMPutSymbol( writer, "scscp1", attr[1] ); - if attr[1] in [ "call_id", "option_min_memory", "option_max_memory", - "option_runtime", "option_debuglevel" ] then - OMPut( writer, attr[2] ); - elif attr[1] in [ "option_return_object", - "option_return_cookie", - "option_return_nothing", - "option_return_deferred" ] then - OMPut( writer, "" ); + OMIndent := 0; + if IN_SCSCP_TRACING_MODE then SCSCPTraceSendMessage( stream![3][1] ); fi; + WriteLine( stream, "" ); + OMPutOMOBJ( writer ); + if IsBound(objrec.attributes) and Length(objrec.attributes)>0 then + has_attributes:=true; + OMPutOMATTR( writer ); + OMPutOMATP( writer ); + for attr in objrec.attributes do + OMPutSymbol( writer, "scscp1", attr[1] ); + if attr[1] in [ "call_id", "option_min_memory", "option_max_memory", + "option_runtime", "option_debuglevel" ] then + OMPut( writer, attr[2] ); + elif attr[1] in [ "option_return_object", + "option_return_cookie", + "option_return_nothing", + "option_return_deferred" ] then + OMPut( writer, "" ); + else + Error("Unsupported option : ", attr[1], "\n" ); + fi; + od; + OMPutEndOMATP( writer ); else - Error("Unsupported option : ", attr[1], "\n" ); + has_attributes:=false; fi; - od; - OMPutEndOMATP( writer ); -else - has_attributes:=false; -fi; -OMPutOMA( writer ); -OMPutSymbol( writer, "scscp1", "procedure_call" ); -if proc_name in [ "get_allowed_heads", - "get_service_description", - "get_signature", - "get_transient_cd", - "is_allowed_head", - "retrieve", - "store_session", - "store_persistent", - "unbind" ] then - OMPutApplication( writer, "scscp2", proc_name, objrec.object ); -else - OMPutApplication( writer, cdname, proc_name, objrec.object ); -fi; -OMPutEndOMA( writer ); -if has_attributes then - OMPutEndOMATTR( writer ); -fi; -OMPutEndOMOBJ( writer ); -WriteLine( stream, "" ); -if IsInputOutputTCPStream( stream ) then - IO_Flush( stream![1] ); -fi; -return true; + OMPutOMA( writer ); + OMPutSymbol( writer, "scscp1", "procedure_call" ); + if proc_name in [ "get_allowed_heads", + "get_service_description", + "get_signature", + "get_transient_cd", + "is_allowed_head", + "retrieve", + "store_session", + "store_persistent", + "unbind" ] then + OMPutApplication( writer, "scscp2", proc_name, objrec.object ); + else + OMPutApplication( writer, cdname, proc_name, objrec.object ); + fi; + OMPutEndOMA( writer ); + if has_attributes then + OMPutEndOMATTR( writer ); + fi; + OMPutEndOMOBJ( writer ); + WriteLine( stream, "" ); + if IsInputOutputTCPStream( stream ) then + IO_Flush( stream![1] ); + fi; + return true; end); ############################################################################# ## ## OMPutProcedureCompleted ( stream, objrec ) -## +## ## The first argument is a stream ## The second argument is a record like the one returned by ## OMGetObjectWithAttributes, for example: ## rec ( object := 120, -## attributes := [ [ "info_runtime", 1000 ], +## attributes := [ [ "info_runtime", 1000 ], ## [ "info_memory", 2048 ], ## [ "call_id", "user007" ] ] ) ## InstallGlobalFunction( OMPutProcedureCompleted, function( stream, objrec ) -local writer, has_attributes, attr; -if IN_SCSCP_BINARY_MODE then - writer:=OpenMathBinaryWriter(stream); -else - writer:=OpenMathXMLWriter(stream); -fi; -if IsClosedStream( stream ) then - Error( "closed stream" ); -fi; -if IsOutputTextStream( stream ) then - SetPrintFormattingStatus( stream, false ); -fi; -OMIndent := 0; -if IN_SCSCP_TRACING_MODE then SCSCPTraceSendMessage(0); fi; -WriteLine( stream, "" ); -OMPutOMOBJ( writer ); -if IsBound(objrec.attributes) and Length(objrec.attributes)>0 then - has_attributes:=true; - OMPutOMATTR( writer ); - OMPutOMATP( writer ); - for attr in objrec.attributes do - if attr[1] in [ "call_id", "info_memory", "info_message", "info_runtime" ] then - OMPutSymbol( writer, "scscp1", attr[1] ); - OMPut( writer, attr[2] ); + local writer, has_attributes, attr; + if IN_SCSCP_BINARY_MODE then + writer:=OpenMathBinaryWriter(stream); else - Error("Unsupported attribute : ", attr[1], "\n" ); + writer:=OpenMathXMLWriter(stream); fi; - od; - OMPutEndOMATP( writer ); -else - has_attributes:=false; -fi; -if IsBound(objrec.object) then - OMPutApplication( writer, "scscp1", "procedure_completed", [ objrec.object ] ); -else - OMPutApplication( writer, "scscp1", "procedure_completed", [ ] ); -fi; -if has_attributes then - OMPutEndOMATTR( writer ); -fi; -OMPutEndOMOBJ( writer ); -WriteLine( stream, "" ); -if IsInputOutputTCPStream( stream ) then - IO_Flush( stream![1] ); -fi; -return true; + if IsClosedStream( stream ) then + Error( "closed stream" ); + fi; + if IsOutputTextStream( stream ) then + SetPrintFormattingStatus( stream, false ); + fi; + OMIndent := 0; + if IN_SCSCP_TRACING_MODE then SCSCPTraceSendMessage(0); fi; + WriteLine( stream, "" ); + OMPutOMOBJ( writer ); + if IsBound(objrec.attributes) and Length(objrec.attributes)>0 then + has_attributes:=true; + OMPutOMATTR( writer ); + OMPutOMATP( writer ); + for attr in objrec.attributes do + if attr[1] in [ "call_id", "info_memory", "info_message", "info_runtime" ] then + OMPutSymbol( writer, "scscp1", attr[1] ); + OMPut( writer, attr[2] ); + else + Error("Unsupported attribute : ", attr[1], "\n" ); + fi; + od; + OMPutEndOMATP( writer ); + else + has_attributes:=false; + fi; + if IsBound(objrec.object) then + OMPutApplication( writer, "scscp1", "procedure_completed", [ objrec.object ] ); + else + OMPutApplication( writer, "scscp1", "procedure_completed", [ ] ); + fi; + if has_attributes then + OMPutEndOMATTR( writer ); + fi; + OMPutEndOMOBJ( writer ); + WriteLine( stream, "" ); + if IsInputOutputTCPStream( stream ) then + IO_Flush( stream![1] ); + fi; + return true; end); ############################################################################# ## ## OMPutProcedureTerminated( stream, objrec, error_cd, error_type ) -## +## ## The first argument is a stream ## The second argument is a record like the one returned by ## OMGetObjectWithAttributes, for example: -## rec ( attributes := [ [ "info_runtime", 1000 ], +## rec ( attributes := [ [ "info_runtime", 1000 ], ## [ "info_memory", 2048 ], ## [ "call_id", "user007" ] ], ## object := "localhost:26133 reports : Rational operations: must not be zero") @@ -734,54 +642,54 @@ end); ## InstallGlobalFunction( OMPutProcedureTerminated, function( stream, objrec, error_cd, error_type ) -local writer, has_attributes, attr; -if IN_SCSCP_BINARY_MODE then - writer:=OpenMathBinaryWriter(stream); -else - writer:=OpenMathXMLWriter(stream); -fi; -if IsClosedStream( stream ) then - Error( "closed stream" ); -fi; -if IsOutputTextStream( stream ) then - SetPrintFormattingStatus( stream, false ); -fi; -OMIndent := 0; -if IN_SCSCP_TRACING_MODE then SCSCPTraceSendMessage(0); fi; -WriteLine( stream, "" ); -OMPutOMOBJ( writer ); -if IsBound(objrec.attributes) and Length(objrec.attributes)>0 then - has_attributes:=true; - OMPutOMATTR( writer ); - OMPutOMATP( writer ); - for attr in objrec.attributes do - if attr[1] in [ "call_id", "info_memory", "info_runtime" ] then - OMPutSymbol( writer, "scscp1", attr[1] ); - OMPut( writer, attr[2] ); + local writer, has_attributes, attr; + if IN_SCSCP_BINARY_MODE then + writer:=OpenMathBinaryWriter(stream); else - Error("Unsupported attribute : ", attr[1], "\n" ); + writer:=OpenMathXMLWriter(stream); fi; - od; - OMPutEndOMATP( writer ); -else - has_attributes:=false; -fi; -OMPutOMA( writer ); -OMPutSymbol( writer, "scscp1", "procedure_terminated" ); -OMPutError( writer, error_cd, error_type, [ objrec.object ] ); -OMPutEndOMA( writer ); -if has_attributes then - OMPutEndOMATTR( writer ); -fi; -OMPutEndOMOBJ( writer ); -WriteLine( stream, "" ); -if IsInputOutputTCPStream( stream ) then - IO_Flush( stream![1] ); -fi; -return true; + if IsClosedStream( stream ) then + Error( "closed stream" ); + fi; + if IsOutputTextStream( stream ) then + SetPrintFormattingStatus( stream, false ); + fi; + OMIndent := 0; + if IN_SCSCP_TRACING_MODE then SCSCPTraceSendMessage(0); fi; + WriteLine( stream, "" ); + OMPutOMOBJ( writer ); + if IsBound(objrec.attributes) and Length(objrec.attributes)>0 then + has_attributes:=true; + OMPutOMATTR( writer ); + OMPutOMATP( writer ); + for attr in objrec.attributes do + if attr[1] in [ "call_id", "info_memory", "info_runtime" ] then + OMPutSymbol( writer, "scscp1", attr[1] ); + OMPut( writer, attr[2] ); + else + Error("Unsupported attribute : ", attr[1], "\n" ); + fi; + od; + OMPutEndOMATP( writer ); + else + has_attributes:=false; + fi; + OMPutOMA( writer ); + OMPutSymbol( writer, "scscp1", "procedure_terminated" ); + OMPutError( writer, error_cd, error_type, [ objrec.object ] ); + OMPutEndOMA( writer ); + if has_attributes then + OMPutEndOMATTR( writer ); + fi; + OMPutEndOMOBJ( writer ); + WriteLine( stream, "" ); + if IsInputOutputTCPStream( stream ) then + IO_Flush( stream![1] ); + fi; + return true; end); ########################################################################### ## -#E +#E ## diff --git a/lib/process.gi b/lib/process.gi index e12b96b..397a8e9 100644 --- a/lib/process.gi +++ b/lib/process.gi @@ -227,11 +227,11 @@ if IN_SCSCP_TRACING_MODE then SCSCPTraceSuspendThread(); fi; IO_Select( [ tcpstream![1] ], [ ], [ ], [ ], 60*60, 0 ); if IN_SCSCP_TRACING_MODE then SCSCPTraceRunThread(); fi; if IN_SCSCP_TRACING_MODE then SCSCPTraceReceiveMessage( tcpstream![3][1] ); fi; -if output_option="tree" then - result := OMGetObjectWithAttributes( tcpstream : return_tree ); -else - result := OMGetObjectWithAttributes( tcpstream ); -fi; +result := OMGetTree(tcpstream); + +if output_option <> "tree" then + result := OMParseXmlObj( result.content[1] ); +fi; if result = fail then Info( InfoSCSCP, 2, "CompleteProcess failed to get result from ", @@ -470,4 +470,4 @@ end); ########################################################################### ## #E -## \ No newline at end of file +##