{$X+,B-,V-,S-} {essential compiler directives}

Program TSTBin; { as of 950301 }

{ Testprogram for the nwBindry unit / NwTP 0.6 API. (c) 1994,1995 R.Spronk }

{ Purpose: Testing only. }

{ Tests the following nwBindry calls:

  AddBinderyObjectToSet
  ChangeBinderyObjectSecurity
  ChangeBinderyObjectPassword
  ChangeEncrBinderyObjectPassword
  ChangePropertySecurity
  CreateBinderyObject
  CreateProperty
  DeleteBinderyObject
  DeleteBinderyObjectFromSet
  DeleteProperty
  GetBinderyAccessLevel
  GetBinderyObjectID
  GetBinderyObjectName
  IsBinderyObjectInSet
  RenameBinderyObject
  VerifyBinderyObjectPassword
  VerifyEncrBinderyObjectPassword
  WritePropertyValue
}

Uses nwMisc,nwBindry;

Procedure Warning(mess:string);
begin
writeln(' ERROR:',mess);
writeln(' ERROR#: $',hexstr(result,2),'  (',result,')');
end;


Function ExistsProperty(objName:string;objType:word;propertyName:String):boolean;

Var propName:string;
    pf,ps   :byte;
    phv,mp  :boolean;
    seqNbr  :LongInt;
begin
seqNbr:=-1;
ExistsProperty:=ScanProperty(objName,objType,propertyname,
                             seqNbr,propName,pf,ps,phv,mp);
end;


Var myObjId:longInt;
    BindSeq:Byte;

    ObjId    :longint;
    usrName,TrueName:string;
    pTrueName:Tproperty;

    replyUsrName:string;
    replyObjType:word;

    t:byte;
    s:string;

begin
writeln('BINTEST Test program for the nwBindry unit of the NwTP package.');

IF not IsShellLoaded
 then begin
      writeln('Please load shell before running.');
      halt(1);
      end;
{ need supervisor privileges to run this test }
GetBinderyAccessLevel(BindSeq,myObjId);
if bindSeq<>(BS_SUPER_WRITE OR BS_SUPER_READ) { $33}
 then begin
      writeln('you need to be supervisor equivalent to run this test program.');
      halt(1);
      end;

writeln('-Assumes there is a group ''EVERYONE''');
writeln('-Non destructive to the bindery. ');
writeln(' (unless you already have a user named ''USR_OINK'' or ''THE_DIVA'')');
writeln;
writeln('For testing of the  unencrypted calls, you must have');
writeln(' SET ALLOW UNENCRYPTED PASSWORDS=ON on the server--');
writeln(' Otherwise these calls will fail and trigger the servers'' intruder detection.');
writeln;
writeln('<ENTER> To Continue..');
readln;

{ you are reminded that the bindery functions turn all object names, property
  names and passwords to upcase. Returned strings are also upcase. }

usrName:='UsR_OiNk';
TrueName:='Miss Piggy';

writeln('Creating Bindery object :',usrName);
IF NOT CreateBinderyObject(usrName,OT_USER,
                           BF_ITEM,BS_ANY_READ OR BS_ANY_WRITE)
 then Warning('couldn''t create a bindery object.');

IF NOT GetBinderyObjectID(usrName,OT_USER,objID)
 then Warning('couldn''t find the created user object');

writeln('Changing object security.');
IF NOT ChangeBinderyObjectSecurity(usrName,OT_USER,BS_LOGGED_READ OR BS_SUPER_WRITE)
 then warning('Couldn''t change object security.');

{ this program assumes there is a group called everyone. }
writeln('Making ',usrName,' a member of the group EVERYONE.');
IF IsBinderyObjectInSet(usrName,OT_USER,
                        'GROUP_MEMBERS','EVERYONE',OT_USER_GROUP)
 then writeln('??: object already is a member of everyone (group)');

IF NOT AddBinderyObjectToSet('EVERYONE',OT_USER_GROUP,'GROUP_MEMBERS',
                              usrName,OT_USER)
 then Warning('couldn''t make user a member of everyone');

IF NOT IsBinderyObjectInSet('EVERYONE',OT_USER_GROUP,'GROUP_MEMBERS',
                        usrName,OT_USER)
 then writeln('??: user is NOT a member of everyone.');


{ ------------AND NOW: the property test.
  create a static property with default security... }
writeln;
writeln('Creating a property IDENTIFICATION associated withe the ',usrName,' object.');
IF NOT CreateProperty(usrName,OT_USER,
                      'IDENTIFICATION',BF_ITEM,BS_ANY_WRITE OR BS_ANY_READ)
 then writeln('Couldn''t create property.');

IF NOT ChangePropertySecurity(usrName,OT_USER,'IDENTIFICATION',
                              BS_LOGGED_READ or BS_SUPER_WRITE)
 then writeln('Couldn''t change property security.');

writeln('Writing the property value: ',trueName);
FillChar(pTrueName[1],SizeOf(pTrueName),#0);
for t:=1 to ord(truename[0]) do pTrueName[t]:=ord(TrueName[t]);

IF NOT WritePropertyValue(usrName,OT_USER,'IDENTIFICATION',1,pTrueName,FALSE)
 then Warning('Couldn''t write the property value.');

{ The next calls were tested before, so they are not tested again.
  They create the minimal properties needed to login as the new object. }

CreateProperty(usrName,OT_USER,'GROUPS_I''M_IN',
               BF_SET,BS_SUPER_WRITE OR BS_LOGGED_READ);

AddBinderyObjectToSet(usrName,OT_USER,'GROUPS_I''M_IN',
                      'EVERYONE',OT_USER_GROUP);

CreateProperty(usrName,OT_USER,'SECURITY_EQUALS',
               BF_SET,BS_SUPER_WRITE OR BS_LOGGED_READ);

AddBinderyObjectToSet(usrName,OT_USER,'SECURITY_EQUALS',
                      'EVERYONE',OT_USER_GROUP);

{------------- Renaming the object. }
writeln;
writeln('Renaming the object.');
UpString(usrName); { make usrName upstring for comparison with found name.}

GetBinderyObjectName(objId,replyUsrName,replyObjType);
IF (nwBindry.result>0) or (replyUsrName<>usrName) or (replyObjType<>OT_USER)
 then Warning('Something very wrong here.');
writeln(' Object name was   :',replyUsrName);

IF NOT RenameBinderyObject(usrName,'THE_DIVA',OT_USER)
 then Warning('Couldn''t rename the object.');

usrName:='THE_DIVA'; {that's what it should be now}

GetBinderyObjectName(objId,replyUsrName,replyObjType);
IF (nwBindry.result<>0) or (replyUsrName<>usrName) or (replyObjType<>OT_USER)
 then Warning('Object was NOT renamed.');
writeln(' Object name now is:',replyUsrName);

{------------ Change and verify bindery object password. }

writeln;
writeln('Changing Object Password. (encrypted)');
IF ChangeEncrBinderyObjectPassword(usrName,OT_USER,'','KERMIT')
 then writeln('Password successfully changed. (encrypted)')
 else Warning('Couldn''t change password. (encrypted)');

writeln('Verifying new password. (encrypted)');
IF VerifyEncrBinderyObjectPassword(usrName,OT_USER,'wrong password')
 then Warning('A wrong (encrypted) password was verified as being OK.');

IF NOT VerifyEncrBinderyObjectPassword(usrName,OT_USER,'KERMIT')
 then Warning('The correct (encrypted) Password was NOT verified.');

{ If you stop execution of this program AT THIS POINT, you will
  have added a user THE_DIVA with password KERMIT, member of the
  group EVERYONE to your bindery. }

{ halt(0); }

writeln;
writeln('WARNING: If you didn''t SET ALLOW UNENCRYPTED PASSWORDS=ON,');
writeln('         -The server will beep;');
writeln('         -Supervisor(s) will receive a 1 line message.');
writeln('          (unless CASTOFF ALL was used);');
writeln('         -The next(unencrypted) calls will fail.');
writeln('         (All the above is essentially harmless)');
writeln;
writeln(' <ENTER> to continue...');
readln;

writeln;
writeln('Changing Object Password. (unencrypted)');
IF ChangeBinderyObjectPassword(usrName,OT_USER,'KERMIT','SECRET')
 then writeln('Password successfully changed. (unencrypted)')
 else Warning('Couldn''t change password. (unencrypted)');

writeln('Verifying new password. (unencrypted)');
IF VerifyBinderyObjectPassword(usrName,OT_USER,'wrong password')
 then Warning('A wrong (unencrypted) password was verified as being OK.');

IF NOT VerifyBinderyObjectPassword(usrName,OT_USER,'SECRET')
 then Warning('The correct (unencrypted) Password was NOT verified.');

{------------ Deleting  properties and objects }
writeln;
writeln('Deleting a property.');
IF NOT DeleteProperty(usrName,OT_USER,'IDENTIFICATION')
 then writeln('Couldn''t delete property.');

IF ExistsProperty(usrName,OT_USER,'IDENTIFICATION')
 then writeln('??:Property wasn''t deleted.');

writeln('Removing the user object from the group EVERYONE.');
DeleteBinderyObjectFromSet(usrName,OT_USER,
                           'GROUP_MEMBERS','EVERYONE',OT_USER_GROUP);

IF IsBinderyObjectInSet(usrName,OT_USER,
                        'GROUP_MEMBERS','EVERYONE',OT_USER_GROUP)
 then writeln('Couldn''t throw '+usrName+' out of everyone (group)');

writeln('Deleting the ',usrName,' object and all related properties.');
IF NOT DeleteBinderyObject(usrName,OT_USER)
 then writeln('Couldn''t delete object.');

IF GetBinderyObjectID(usrName,OT_USER,objID)
 then writeln('??: deleted object still exists.');

end.