þa‹RþwQþ mP9þhý oPþ nSystem-wide$NOLIST $OPTIMIZE (3) $INCLUDE (``OsIncs`Os.Model.Inc~Text~) UserProfile: DO; /* This is os.profile.plm. It contains routines */ /* that manage the user profile. */ /* Author: Phil Ydens */ /* Date: 10/4/82 */ $INCLUDE (``Incs`PlmLits.Inc~Text~) $INCLUDE (``OsIncs`Os.Constant.Inc~Text~) $INCLUDE (``OsIncs`Os.Error.Inc~Text~) $INCLUDE (``OsIncs`Os.Type.Inc~Text~) $INCLUDE (``OsIncs`Os.FsRequest.Ext.Inc~Text~) $INCLUDE (``OsIncs`Os.Windows.Ext.Inc~Text~) $INCLUDE (``OsIncs`Os.Sysdep.Ext.Inc~Text~) $INCLUDE (``OsIncs`Os.OsSubs.Ext.Inc~Text~) $INCLUDE (``OsIncs`Os.MemMgr.Ext.Inc~Text~) $INCLUDE (``OsIncs`Cp.Misc.Ext.Inc~Text~) $INCLUDE (``OsIncs`Cp.MemMgr.Ext.Inc~Text~) /* Structures */ DCL BlockType LIT 'STRUCTURE (length WORD, tag WORD, info (1) BYTE)'; /* Public Variables */ DCL profileLength WORD PUBLIC; DCL memoryLength WORD PUBLIC; DCL pUserProfile PTR PUBLIC; DCL pProfilePath PTR PUBLIC; DCL userProfileArea BASED pUserProfile (1) BYTE; /* External Variables */ DCL windowFrameFlag BYTE EXTERNAL; DCL INGRiDPid PidType EXTERNAL; /* External Procedures */ SetDefaultWindow: PROCEDURE (pid) EXTERNAL; DCL pid PidType; END; $EJECT /* AttachAndOpen */ AttachAndOpen: PROCEDURE (pPath, mode, access) ConnectionType CLEAN; DCL mode BYTE; DCL access BYTE; DCL pPath PTR; DCL error WORD; DCL conn ConnectionType; conn = OsAttach (pPath, mode, @(0), access, @error); IF error <> eOk THEN RETURN (NULLWORD); CALL OsOpen (conn, 1, @error); IF error = eOk THEN RETURN (conn); CALL OsDetach (conn, @error); RETURN (NULLWORD); END; /* AccessUserProfile */ /* This routine will attach and open the user */ /* profile. */ AccessUserProfile: PROCEDURE (fileMode) ConnectionType CLEAN; DCL fileMode BYTE; DCL attached BOOLEAN; DCL error WORD; DCL conn ConnectionType; attached = FALSE; IF fileMode = oldFileMode THEN DO; /* Search for the user profile */ pProfilePath = OsSearchForTitle (@(13, 'User~Profile~'), FALSE, TRUE); END; ELSE IF fileMode = newFileMode THEN DO; /* profile was not found at bootup. Look for one */ pProfilePath = IntAllocate (systemPid, 63, @error); IF error <> eOk THEN RETURN (NULLWORD); CALL InitSearch (TRUE); attached = FALSE; DO WHILE NOT attached; BEGIN IF NOT GetNextDevice (@(23, '`Programs`User~Profile~'), pProfilePath) THEN DO; CALL IntFree (pProfilePath); pProfilePath = NULLPTR; attached = TRUE; END; ELSE DO; conn = AttachAndOpen (pProfilePath, fileMode, updateAccess); IF conn <> NULLWORD THEN attached = TRUE; END; END; CALL CleanUpSearch; END; IF pProfilePath = NULLPTR THEN RETURN (NULLWORD); IF NOT attached THEN conn = AttachAndOpen (pProfilePath, fileMode, updateAccess); RETURN (conn); /* CALL OsOpen (conn, 1, @error); IF error = eOk THEN RETURN (conn); CALL OsDetach (conn, @dummy); RETURN (NULLWORD); */ END; /* AccessUserProfile */ $EJECT /* ReadUserProfile */ /* This routine will read the user profile. It */ /* is called at boot time. */ ReadUserProfile: PROCEDURE CLEAN; DCL length WORD; DCL dummy WORD; DCL error WORD; DCL conn ConnectionType; DCL statusInfo StatusType; pUserProfile = NULLPTR; profileLength = 0; memoryLength = 0; conn = AccessUserProfile (oldFileMode); IF conn = NULLWORD THEN RETURN; CALL OsGetStatus (conn, @StatusInfo, SIZE (statusInfo), @error); IF error <> eOk THEN GOTO ReadUserProfileExit; pUserProfile = IntAllocate (systemPid, statusInfo.fileLength, @error); IF error <> eOk THEN GOTO ReadUserProfileExit; length = OsRead (conn, pUserProfile, statusInfo.fileLength, @error); IF error <> eOk THEN DO; CALL IntFree (pUserProfile); GOTO ReadUserProfileExit; END; profileLength = statusInfo.fileLength; memoryLength = statusInfo.fileLength; ReadUserProfileExit: CALL OsDetach (conn, @dummy); IF error <> eOk THEN pUserProfile = NULLPTR; RETURN; END; /* ReadUserProfile */ $EJECT /* IntGetProperty */ /* This routine will search the user profile for */ /* a record (block) that matches the tag word */ /* passed in. It will return a pointer to that */ /* record. */ IntGetProperty: PROCEDURE (tag, pCurPosition, pError) PTR CLEAN; DCL tag WORD; DCL pCurPosition PTR; DCL pError PTR; DCL found BOOLEAN; DCL pBlock PTR; DCL block BASED pBlock BlockType; DCL error BASED pError WORD; DCL curPosition BASED pCurPosition WORD; error = eParam; pBlock = pUserProfile; IF pBlock = NULLPTR THEN RETURN (pBlock); found = FALSE; curPosition = 0; DO WHILE (not found) AND (curPosition < profileLength); BEGIN IF block.tag = tag THEN found = TRUE; ELSE DO; curPosition = curPosition + block.length; pBlock = BUILDPTR (SELECTOROF(pBlock), OFFSETOF (pBlock) + block.length); END; END; IF NOT found THEN RETURN (NULLPTR); error = eOk; RETURN (pBlock); END; /* IntGetProperty */ $EJECT /* OsGetProperty */ /* This routine will search the user profile for */ /* a record (block) that matches the tag word */ /* passed in. It will return a pointer to that */ /* record. */ OsGetProperty: PROCEDURE (tag, pLength, pData, pError) CLEAN; DCL tag WORD; DCL pLength PTR; DCL pData PTR; DCL pError PTR; DCL curPosition WORD; DCL pBlock PTR; DCL block BASED pBlock BlockType; DCL length BASED pLength WORD; DCL dataBuf BASED pData (1) BYTE; DCL error BASED pError WORD; pBlock = IntGetProperty (tag, @curPosition, pError); length = block.length - 4; IF error = eOk THEN CALL MOVB (@block.info, @dataBuf, length); END; /* OsGetProperty */ $EJECT /* MoveInfo */ /* This routine will move the info over from the */ /* parms into the user profile. */ MoveInfo: PROCEDURE (pBlock, tag, length, pData) CLEAN; DCL tag WORD; DCL length WORD; DCL pBlock PTR; DCL pData PTR; DCL block BASED pBlock BlockType; block.tag = tag; block.length = length + 4; CALL MOVB (pData ,@block.info, length); END; /* MoveInfo */ /* MakeMoreRoom */ /* This routine will try to allocate more room for*/ /* the user profile and will move the current user*/ /* profile over and will also append the block */ /* that is to be added. */ MakeMoreRoom: PROCEDURE (tag, length, pData) WORD CLEAN; DCL tag WORD; DCL length WORD; DCL pData PTR; DCL error WORD; DCL dummy WORD; DCL pNewArea PTR; pNewArea = IntAllocate (systemPid, profileLength + length + 4, @error); IF error <> eOk THEN RETURN(error); IF pUserProfile <> NULLPTR THEN DO; CALL MOVB (pUserProfile, pNewArea, profileLength); CALL IntFree (pUserProfile); /* IF error <> eOk THEN DO; CALL CpFree (pNewArea, @dummy); RETURN (error); END; */ END; pUserProfile = pNewArea; CALL MoveInfo (@userProfileArea(profileLength), tag, length, pData); profileLength = profileLength + length + 4; memoryLength = profileLength; RETURN (eOk); END; /* MakeMoreRoom */ $EJECT /* OsPutProperty */ /* This routine will put properties into the user */ /* profile. If the user profile does not exist */ /* this routine will create it. This routine will*/ /* attempt to update the user profile by searching*/ /* for tag fields that match the one to be */ /* inserted. If found then the new block is added*/ /* to the profile at that point. This might mean */ /* that the portion of the profile below this */ /* entry has to move based on the size of the */ /* block to be inserted. Also, if more space is */ /* to be added to the profile, then this routine */ /* will take care of that also. */ OsPutProperty: PROCEDURE (tag, length, pData, pError) CLEAN; DCL tag WORD; DCL length WORD; DCL pData PTR; DCL pError PTR; DCL position WORD; DCL dummy WORD; DCL oldLength WORD; DCL conn ConnectionType; DCL pOldBlock PTR; DCL pNextBlock PTR; DCL pNewNextBlock PTR; DCL error BASED pError WORD; DCL oldBlock BASED pOldBlock BlockType; DCL dataBuf BASED pData (1) BYTE; error = eAccess; IF tag = timeOffsetTag THEN DO; IF CpSetTime (pData) THEN RETURN; END; IF pUserProfile = NULLPTR THEN DO; /* No user profile yet. */ conn = AccessUserProfile (newFileMode); IF conn = NULLWORD THEN RETURN; profileLength = 0; memoryLength = 0; END; ELSE DO; conn = AccessUserProfile (updateFileMode); IF conn = NULLWORD THEN RETURN; END; $EJECT pOldBlock = IntGetProperty (tag, @position, @error); oldLength = oldBlock.length; IF error = eOk THEN DO; /* found an old record with the same tag. */ IF oldLength = length + 4 THEN CALL MoveInfo (pOldBlock, tag, length, pData); ELSE IF oldLength > length + 4 THEN DO; pNextBlock = @userProfileArea (position + oldLength); pNewNextBlock = @userProfileArea (position + length + 4); CALL MoveInfo (pOldBlock, tag, length, pData); CALL MOVB (pNextBlock, pNewNextBlock, profileLength - (position + oldLength)); profileLength = profileLength - (oldLength - length - 4); END; ELSE /* need to make room */ DO; pNextBlock = @userProfileArea (position + oldLength); CALL MOVB (pNextBlock, pOldBlock, profileLength - (position + oldLength)); profileLength = profileLength - oldLength; IF memoryLength < profileLength + length + 4 THEN DO; error = MakeMoreRoom (tag, length, pData); IF error <> eOk THEN GOTO PutExit; END; ELSE DO; CALL MoveInfo (@userProfileArea (profileLength), tag, length, pData); profileLength = profileLength + length + 4; END; END; END; ELSE DO; /* No old block found */ IF memoryLength < profileLength + length + 4 THEN DO; error = MakeMoreRoom (tag, length, pData); IF error <> eOk THEN GOTO PutExit; END; ELSE DO; CALL MoveInfo (@userProfileArea (profileLength), tag, length, pData); profileLength = profileLength + length + 4; END; END; $EJECT /* Now flush out the user profile */ CALL OsWrite (conn, pUserProfile, profileLength, @error); IF error <> eOk THEN GOTO PutExit; CALL OsTruncate (conn, @error); CALL OsDetach (conn, @error); IF tag = frameTag THEN DO; windowFrameFlag = dataBuf(0); CALL SetDefaultWindow (INGRiDPid); CALL WinInitDefaultWindow; END; RETURN; PutExit: IF error <> eOk THEN CALL OsDetach (conn, @dummy); END; /* OsPutProperty */ END; /* UserProfile */