/***************************************************************************************/ /* */ /* SCS editor Version 2 */ /* File : Site.pkg */ /* Version : 22 Mai 2000 */ /* Site struct and functions */ /* */ /***************************************************************************************/ /**************************************************************************************** STRUCT ****************************************************************************************/ var SITE_FILENAME_PARAMETER = "$site_filename";; var SITE_PASSWORD_PARAMETER = "$site_password";; var SITE_PORT_PARAMETER = "$site_port";; struct SiteOptions = [ SITEname : S , /* site name */ SITEversion : I , /* site version (number of save) */ SITEdate : S , /* site date of last save */ SITEdirectory : S , /* site directory (without filename)*/ SITEportNumber : I , /* site port number */ SITEtimeout : I , /* site client disconnection timeout */ SITEloadCapacity : I , /* site client load capacity */ SITEauthorName : S , /* author of site */ SITEauthorEmail : S , /* author's email address */ SITEdescription : S , /* Optional site description */ SITElang : S , /* For feedback information purposes */ SITEscolFileContent : S , /* site Scol file content */ SITEsatelliteScolFileContent : S , /* site satellite Scol file content */ SITEscreenshotName : S , /* site Screenshot bitmap filename */ SITEpassword : S /* site satellites password */ ] mkSiteOptions ;; struct Site = [ SITEfilename : S , /* site filename */ SITEmodified : I , /* site modification state */ SITEmoduleTreeRoot : [Module r1 r1 r1 r1] , /* modules tree root */ SITEclientZonesTreeRoot : [Zone r1 r1 r1 r1] , /* client zones tree root */ SITEserverZonesTreeRoot : [Zone r1 r1 r1 r1] , /* server zones tree root */ SITEclientAssociations : [Association r1] , /* client zones associations */ SITEserverAssociations : [Association r1] , /* server zones associations */ SITEblackboxView : Module , /* blackbox corresponding to current view */ SITEoptions : SiteOptions , /* various site options */ SITEhistory : History , /* history of every operations */ SITEservers : [[S S S] r1] , /* site servers */ SITEproperties : [[S S] r1] /* site user properties */ ] mkSite ;; /* root default dmi values */ var ROOT_DMI = ("in"::"enter"::nil):: ("in"::"full"::nil):: ("in"::"in"::nil):: ("in"::"log"::nil):: ("in"::"out"::nil):: ("in"::"start"::nil):: nil;; /**************************************************************************************** External function prototypes ****************************************************************************************/ proto SITE_ChangeStatus = fun [] I;; /**************************************************************************************** Local function prototypes ****************************************************************************************/ proto SITE_ParseModule = fun [Site [Module r1 r1 r1 r1] DEF Chn] [Module r1 r1 r1 r1];; proto SITE_ParseLink = fun [Site Module [[S r1] r1]] I;; proto SITE_ParseModuleDef = fun [Site Module] DEF;; proto ZONE_Add = fun [Site Zone I] Zone;; proto ZONE_SimpleSetName = fun [Site Zone S] I;; proto SITE_ParseAssociation = fun [Site Module [[S r1] r1]] I;; proto ASSO_RealAddAssociation = fun [Site Zone Module S] Association;; /**************************************************************************************** comparison function by site filename ****************************************************************************************/ fun SITE_CompareFilename (site, filename) = !strcmpi site.SITEfilename filename ;; /*************************************************************************************** MODULE FUNCTIONS ***************************************************************************************/ /**************************************************************************************** search function by module in module tree ****************************************************************************************/ fun SITE_SearchModuleNode (site, module) = MODULE_GetNode module;; /**************************************************************************************** return the list of module node from list of module in module tree ****************************************************************************************/ fun SITE_SearchModuleNodeList (site, moduleList) = if moduleList == nil then nil else (SITE_SearchModuleNode site hd moduleList)::(SITE_SearchModuleNodeList site tl moduleList) ;; /**************************************************************************************** insert module in module tree ****************************************************************************************/ fun SITE_InsertNewModule (site, father, module) = TREE_AddNodeToChildTail (SITE_SearchModuleNode site father) (MODULE_MkNode module) ;; /*************************************************************************************** Get a module by its name in a list of module Return value: Module (success) or nil (failure) ***************************************************************************************/ fun SITE_GetModuleByName (site, moduleList, name) = if moduleList == nil then nil else let moduleList -> [module nextModule] in if !strcmpi module.MODname name then module else SITE_GetModuleByName site nextModule name ;; fun SITE_GetModuleCompleteName2 (moduleTree) = if moduleTree == nil then nil else let TREE_Val moduleTree -> module in listcat (SITE_GetModuleCompleteName2 TREE_Father moduleTree) (module.MODname::nil) ;; fun SITE_GetModuleCompleteName (site, module) = SITE_GetModuleCompleteName2 SITE_SearchModuleNode site module ;; fun SITE_CompareModuleName (treeModule, name) = MODULE_CompareName TREE_Val treeModule name ;; fun SITE_GetModuleByCompleteName (treeModule, listName) = if (treeModule == nil) || (listName == nil) then nil else let TREE_Val treeModule -> module in if MODULE_CompareName module hd listName then if (tl listName) == nil then module else SITE_GetModuleByCompleteName search_in_list TREE_ListOfAllBrothers (TREE_FirstChild treeModule) @SITE_CompareModuleName (hd tl listName) tl listName else nil ;; /*************************************************************************************** Get current visible blackbox Return value: Module (success) or nil (failure) ***************************************************************************************/ fun SITE_GetModuleCurrentBlackBox (site) = site.SITEblackboxView ;; /*************************************************************************************** Set current visible blackbox Return value: Module (success) or nil (failure) ***************************************************************************************/ fun SITE_SetModuleCurrentBlackBox (site, module) = set site.SITEblackboxView = module ;; /*************************************************************************************** ZONE FUNCTIONS ***************************************************************************************/ /*************************************************************************************** Return the client or server zone tree root from a site Return value: [Zone r1 r1 r1 r1] (success) or nil (failure) ***************************************************************************************/ fun SITE_FilterZoneTree (site, side)= if side == SCS_SERVER then site.SITEserverZonesTreeRoot else if side == SCS_CLIENT then site.SITEclientZonesTreeRoot else /* ERROR NOT SENT TO END-USER */ logScsError "SITE_FilterZoneTree" "side="::(itoa side)::nil "unknown side value" nil ;; /*************************************************************************************** Return a zone from a site Return value: [Zone r1 r1 r1 r1] (success) or nil (failure) ***************************************************************************************/ fun SITE_SearchZoneNode (site, zone) = TREE_SearchNode (SITE_FilterZoneTree site zone.ZONEsideFlag) zone TREE_PRE_ORDER ;; /**************************************************************************************** return the list of zone node from list of zone in zone tree ****************************************************************************************/ fun SITE_SearchZoneNodeList (site, zoneList) = if zoneList == nil then nil else (SITE_SearchZoneNode site hd zoneList)::(SITE_SearchZoneNodeList site tl zoneList) ;; fun SITE_CompareZoneName (treeZone, name) = ZONE_CompareName TREE_Val treeZone name ;; fun SITE_CompareZoneNameButNotSameZone (treeZone, zone) = let TREE_Val treeZone -> currZone in (currZone != zone) && (ZONE_CompareName currZone zone.ZONEname) ;; fun SITE_GetZoneByCompleteName (treeZone, listName) = if (treeZone == nil) || (listName == nil) then nil else let TREE_Val treeZone -> zone in if ZONE_CompareName zone hd listName then if (tl listName) == nil then zone else SITE_GetZoneByCompleteName search_in_list TREE_ListOfAllBrothers (TREE_FirstChild treeZone) @SITE_CompareZoneName (hd tl listName) tl listName else nil ;; fun SITE_GetZoneCompleteName2 (zoneTree) = if zoneTree == nil then nil else let TREE_Val zoneTree -> zone in listcat (SITE_GetZoneCompleteName2 TREE_Father zoneTree) (zone.ZONEname::nil) ;; fun SITE_GetZoneCompleteName (site, zone) = SITE_GetZoneCompleteName2 SITE_SearchZoneNode site zone ;; fun SITE_DuplicateZone (zoneNode, fatherNode) = if zoneNode == nil then nil else let TREE_MkNode ZONE_Duplicate TREE_Val zoneNode -> newZoneNode in ( if fatherNode == nil then nil else TREE_AddNodeToChildTail fatherNode newZoneNode; let TREE_NextBrother zoneNode -> brotherNode in SITE_DuplicateZone brotherNode fatherNode; let TREE_FirstChild zoneNode -> childNode in SITE_DuplicateZone childNode newZoneNode; newZoneNode ) ;; /*************************************************************************************** LINKS FUNCTIONS ***************************************************************************************/ /*************************************************************************************** return the list of couple of adjacent modules from a list of modules Validated by macfly 31/05/2000 ***************************************************************************************/ fun SITE_ConstructPathFromList (list) = if list == nil then nil else let hd tl list -> suite in if suite == nil then nil else [(hd list) suite]::(SITE_ConstructPathFromList tl list) ;; /*************************************************************************************** return the paths of modules for creating link(s) between two modules Validated by macfly 31/05/2000 ***************************************************************************************/ fun SITE_GetLinkPath (site, module1, module2) = if module1 == nil || module2 == nil then nil else let SITE_SearchModuleNode site module1 -> module1Node in if module1Node == nil then logScsError "SITE_GetLinkPath" nil "Node not found for module 1" nil else let SITE_SearchModuleNode site module2 -> module2Node in if module2Node == nil then logScsError "SITE_GetLinkPath" nil "Node not found for module 2" nil else let TREE_SearchFirstParentAndPath module1Node module2Node -> [path1 path2 result _] in if !result then logScsError "SITE_GetLinkPath" nil "Unable to find common parent" nil else SITE_ConstructPathFromList listcat module1::(tl TREE_ListValOfList path1) (listcat (mirror (tl TREE_ListValOfList path2)) module2::nil) ;; /**************************************************************************************** OTHERS ****************************************************************************************/ /**************************************************************************************** return site history ****************************************************************************************/ fun SITE_GetHistory (site) = site.SITEhistory ;; fun SITE_NewScolFileContent () = strcatn "_load \"Dms/L/dhdms/go.pkg\"\n":: "go\n":: "main \""::SITE_FILENAME_PARAMETER::"\"\n":: nil ;; fun SITE_NewSatelliteScolFileContent () = strcatn "_load \"Dms/L/dhdms2/satgo.pkg\"\n":: "go\n":: "main "::SITE_PORT_PARAMETER::" \""::SITE_PASSWORD_PARAMETER::"\"\n":: nil ;; fun SITE_CheckScolFileContent (site, content) = if (site.SITEfilename == nil) || (content == nil) then 0 else if (strfindi site.SITEfilename content 0)==nil then ( ERRORS_AddError 2 63 (_locSCS "errorlabel-CANNOTRUN" nil); 0 ) else 1 ;; fun SITE_ContentFilenameToParam (site, content) = replace_in_string if SITE_CheckScolFileContent site content then replace_in_string content site.SITEfilename SITE_FILENAME_PARAMETER else content site.SITEoptions.SITEpassword SITE_PASSWORD_PARAMETER ;; fun SITE_ScolFileContentParamToFilename (site, filename) = replace_in_string replace_in_string site.SITEoptions.SITEscolFileContent SITE_FILENAME_PARAMETER filename SITE_PASSWORD_PARAMETER site.SITEoptions.SITEpassword ;; fun SITE_SatelliteScolFileContentParamToAll (site, port) = replace_in_string replace_in_string site.SITEoptions.SITEsatelliteScolFileContent SITE_PORT_PARAMETER port SITE_PASSWORD_PARAMETER site.SITEoptions.SITEpassword ;; fun SITE_CompareServers (srv1, srv2) = let srv1 -> [numS1 _ _] in let srv2 -> [numS2 _ _] in if numS1==nil || numS2==nil then (-1) else (atoi numS1)-(atoi numS2) ;; fun SITE_SearchServerByNum (srv, numdat) = let srv -> [num _ _] in !strcmpi num numdat ;; fun SITE_CheckServerValue (valS) = let atoi valS -> val in if val == nil || val <= 0 then ( ERRORS_AddError 1 61 (_locSCS "errorlabel-ADDINGSERVER" nil); 0 ) else 1 ;; fun SITE_GetSingleName (filename) = replace_in_string filename ".dms" ".single.dms";; fun SITE_CompareProperties (prop1, prop2) = let prop1 -> [keyS1 _] in let prop2 -> [keyS2 _] in if keyS1==nil || keyS2==nil then (-1) else strcmpi keyS1 keyS2 ;; fun SITE_SearchPropertieByKey (proper, keydat) = let proper -> [key _] in !strcmpi key keydat ;; fun SITE_GetLocalSatellite (listsatellite) = if listsatellite == nil then nil else let listsatellite -> [cur next] in let cur -> [_ ip _] in if !strcmp ip "127.0.0.1" then cur::(SITE_GetLocalSatellite next) else SITE_GetLocalSatellite next ;;