DBMgr

program DBMgr;
{$mode objfpc}{$H+}
uses sysutils, strutils, base64, MD5;

{= Variables & Constants ======================================================}

const
 {LoginSalt1 = 'UQUfKmbDzAgjm97n';
 LoginSalt2 = '57U0bnM7iCU0kGHc';
 LoginSalt3 = '78ElGbeaRY8JIS9N';}
 PasswordSalt1 = 'ypgbGbEnUqrTA9MH';
 PasswordSalt2 = 'VlraVUZCPqF3o2vL';
 PasswordSalt3 = 'EKyvJaboNlkch62Z';

 SepChar:char = '|';

{= Procedures & Functions =====================================================}

{function ValidData(d:string):boolean;
begin
 result:= not (pos(SepChar,d)>0);
end;}

{function EncryptMD5Login(l:string):string;
begin
 result:=MD5Print(MD5String(MD5Print(MD5String(LoginSalt1+l+LoginSalt2))+LoginSalt3));
end;}

function EncryptMD5Password(p:string):string;
begin
 result:=MD5Print(MD5String(MD5Print(MD5String(PasswordSalt1+p+PasswordSalt2))+PasswordSalt3));
end;

function EncryptBase64(t:string):string;
begin
 result:=base64.EncodeStringBase64(t);
end;

function DecryptBase64(t:string):string;
begin
 result:=base64.DecodeStringBase64(t);
end;

{= DB compress ================================================================}
type TDBItemPerms=(tdbit_administrator,tdbit_manager,tdbit_user);

type TDBItem=object
 public
 ID:Cardinal;
 item_login,crypted_password:string;
 item_perm:TDBItemPerms;
 datatext:string;
 procedure FromDBObj(s:string);
 function ToDBObj:string;
end;

procedure TDBItem.FromDBObj(s:string);
begin
 s:=DecryptBase64(s);
 self.id:=StrToInt(Copy(s,1,pos(SepChar,s)-1));
 Delete(s,1,pos(SepChar,s));
 self.item_login:=Copy(s,1,pos(SepChar,s)-1);
 Delete(s,1,pos(SepChar,s));
 self.crypted_password:=Copy(s,1,pos(SepChar,s)-1);
 Delete(s,1,pos(SepChar,s));
 self.item_perm:=TDBItemPerms(StrToInt(Copy(s,1,pos(SepChar,s)-1)));
 Delete(s,1,pos(SepChar,s));
 self.datatext:=DecryptBase64(s);
end;

function TDBItem.ToDBObj:string;
begin
 result:=
 EncryptBase64(
 IntToStr(Self.ID) + SepChar +
 self.item_login + SepChar +
 self.crypted_password + SepChar +
 IntToStr(Integer(self.item_perm)) + SepChar +
 EncryptBase64(self.datatext)
 );
end;

type TDB=object
 protected
 Data:array of TDBItem;
 MyAccountID:cardinal;
 Autorized:boolean;
 public
 procedure OpenDB(path:string);
 procedure SaveDB(path:string);
 procedure CreateDB(path:string);
 function GetItemIndex(login:string):cardinal;
 procedure Auth(login,pass:string);
 procedure AddUser(Login,Pass:string; Perm:TDBItemPerms);
 procedure SetNewLogin(OldLogin,NewLogin:string);
 procedure DeleteItem(Login:string);
 procedure SetNewPass(Login,NewPass:string);
 procedure SetDataText(Login,DText:string);
 procedure Reg(Login,Pass:string);
 function GetNextID:cardinal;
 function GetDataText(Login:string):string;
 procedure Print;
 procedure Me;
 procedure Find(s:string);
end;

procedure TDB.Print;
var i:cardinal;
begin
 if length(self.data)=0 then
 begin
 writeln('null');
 exit;
 end;
 writeln('======================================');
 writeln('DB list of registered:');
 writeln('======================================');
 for i:=0 to length(self.data)-1 do
 begin
 case self.data[i].item_perm of
 tdbit_administrator:write('[ADMINISTRATOR] | ');
 tdbit_manager: write('[MANAGER] | ');
 tdbit_user: write('[USER] | ');
 end;
 writeln(self.data[i].item_login);
 end;
 writeln('======================================');
end;

procedure TDB.SetDataText(Login,DText:string);
var
 i:cardinal;
begin
 if not Autorized then
 begin
 writeln('Please login. Hint: user auth <login> <password>');
 exit;
 end;
 i:=GetItemIndex(Login);
 if i=length(self.data) then
 begin
 writeln('User "'+login+'" not found.');
 exit;
 end;
 if (((Self.Data[MyAccountID].item_perm=tdbit_manager)and(Self.Data[i].item_perm<>tdbit_user))
 or (Self.Data[MyAccountID].item_perm=tdbit_user)) and (MyAccountID<>i)
 then begin
 WriteLn('You don''t have permissions for do that.');
 exit;
 end;
 if length(DText)=0 then
 Self.Data[i].datatext:='null'
 else
 Self.Data[i].datatext:=DText;
end;

function TDB.GetDataText(Login:string):string;
var
 i:cardinal;
begin
 if not Autorized then
 begin
 writeln('Please login. Hint: user auth <login> <password>');
 exit;
 end;
 i:=GetItemIndex(Login);
 if i=length(self.data) then
 begin
 writeln('User "'+login+'" not found.');
 exit;
 end;
 if (((Self.Data[MyAccountID].item_perm=tdbit_manager)and(Self.Data[i].item_perm<>tdbit_user))
 or (Self.Data[MyAccountID].item_perm=tdbit_user)) and (MyAccountID<>i)
 then begin
 WriteLn('You don''t have permissions for do that.');
 exit;
 end;
 result:=Self.Data[i].datatext;
end;

procedure TDB.SetNewLogin(OldLogin,NewLogin:string);
var
 i:cardinal;
begin
 if not Autorized then
 begin
 writeln('Please login. Hint: user auth <login> <password>');
 exit;
 end;
 if GetItemIndex(NewLogin)<>Length(Self.Data) then
 begin
 Writeln('Login "'+NewLogin+'" already reserved.');
 exit;
 end;
 i:=GetItemIndex(OldLogin);
 if i=length(self.data) then
 begin
 writeln('User "'+oldlogin+'" not found.');
 exit;
 end;
 if (((Self.Data[MyAccountID].item_perm=tdbit_manager)and(Self.Data[i].item_perm<>tdbit_user))
 or (Self.Data[MyAccountID].item_perm=tdbit_user)) and (MyAccountID<>i)
 then begin
 WriteLn('You don''t have permissions for do that.');
 exit;
 end;
 Self.Data[i].item_login:=NewLogin;
end;

procedure TDB.SetNewPass(Login,NewPass:string);
var
 i:cardinal;
begin
 if not Autorized then
 begin
 writeln('Please login. Hint: user auth <login> <password>');
 exit;
 end;
 i:=GetItemIndex(Login);
 if i=length(self.data) then
 begin
 writeln('User "'+login+'" not found.');
 exit;
 end;
 if (((Self.Data[MyAccountID].item_perm=tdbit_manager)and(Self.Data[i].item_perm<>tdbit_user))
 or (Self.Data[MyAccountID].item_perm=tdbit_user)) and (MyAccountID<>i)
 then begin
 WriteLn('You don''t have permissions for do that.');
 exit;
 end;
 Self.Data[i].crypted_password:=EncryptMD5Password(NewPass);
end;

procedure TDB.DeleteItem(Login:string);
var
 i:cardinal;
begin
 if not Autorized then
 begin
 writeln('Please login. Hint: user auth <login> <password>');
 exit;
 end;
 i:=GetItemIndex(Login);
 if i=length(self.data) then
 begin
 writeln('User "'+login+'" not found.');
 exit;
 end;
 if (((Self.Data[MyAccountID].item_perm=tdbit_manager)and(Self.Data[i].item_perm<>tdbit_user))
 or (Self.Data[MyAccountID].item_perm=tdbit_user)) and (MyAccountID<>i)
 then begin
 WriteLn('You don''t have permissions for do that.');
 exit;
 end;
 if MyAccountID=i then autorized:=false;
 if MyAccountID=length(self.data)-1 then
  MyAccountID:=i;
 Self.Data[i]:=Self.Data[length(self.data)-1];
 setlength(self.data,length(self.data)-1);
end;

function TDB.GetNextID:cardinal;
 function max(a,b:cardinal):cardinal;
 begin
 if a>=b then result:=a else result:=b;
 end;
 var i,maxID:cardinal;
begin
 if length(Self.Data)=0 then
 begin
 result:=0;
 exit;
 end;
 maxID:=Self.Data[0].ID;
 for i:=1 to Length(Self.Data)-1 do
 begin
 maxID:=max(self.data[i].id,maxID);
 end;
 result:=maxID+1;
end;

procedure TDB.OpenDB(path:string);
var
 f:textfile;
 buf:string;
begin
 try
 SetLength(Self.Data,0);
 Assign(f,path);
 Reset(f);
 while not Eof(f) do
 begin
 readln(f,buf);
 SetLength(Self.Data,Length(Self.Data)+1);
 Self.Data[Length(Self.Data)-1].FromDBObj(buf);
 end;
 Close(f);
 Autorized:=false;
 writeln('Success.');
 except
 writeln('We get trouble, when open "'+path+'".');
 end;
end;

procedure TDB.reg(login,pass:string);
begin
 if GetItemIndex(Login)<>Length(Self.Data) then
 begin
 Writeln('Login "'+Login+'" already reserved.');
 exit;
 end;
 SetLength(Self.Data,Length(Self.Data)+1);
 with Self.Data[length(Self.Data)-1] do
 begin
 id:=GetNextID;
 item_login:={EncryptMD5Login}(Login);
 crypted_password:=EncryptMD5Password(Pass);
 if length(Self.Data)=1 then
 item_perm:=tdbit_administrator
 else
 item_perm:=tdbit_user;
 datatext:='null';
 end;
 writeln('Success.');
end;

procedure TDB.SaveDB(path:string);
label
 SelfExit;
var
 f:textfile;
 i:cardinal;
begin
 try
 Assign(f,path);
 Rewrite(f);
 if length(self.Data)=0 then goto SelfExit;
 for i:=0 to length(Self.Data)-2 do
 writeln(f,Self.Data[i].ToDBObj);
 write(f,Self.Data[Length(Self.Data)-1].ToDBObj);
 SelfExit:
 Close(f);
 writeln('Success.');
 except
 writeln('We get trouble, when save "'+path+'".');
 end;
end;

procedure TDB.CreateDB(path:string);
var
 f:textfile;
begin
 try
 SetLength(Self.Data,0);
 Assign(f,path);
 Rewrite(f);
 Close(f);
 writeln('Success.');
 except
 writeln('We get trouble, when create "'+path+'".');
 end;
end;

function TDB.GetItemIndex(login:string):cardinal;
label
 SelfExit;
var
 i:cardinal;
begin
 if length(Self.Data)=0 then goto SelfExit;
 for i:=0 to Length(Self.Data)-1 do
 if Self.Data[i].item_login=login then
 begin
 result:=i;
 exit;
 end;
 SelfExit:
 result:=Length(Self.Data);
end;

procedure TDB.Auth(login,pass:string);
var i:cardinal;
begin
 i:=GetItemIndex({EncryptMD5Login}(login));
 if i=length(self.data) then
 begin
 writeln('User "'+login+'" not found.');
 exit;
 end;
 if Self.Data[i].crypted_password=EncryptMD5Password(pass) then
 begin
 MyAccountID:=i;
 Autorized:=true;
 writeln('Success.');
 end
 else
 Writeln('Wrong password.');
end;

procedure TDB.AddUser(Login,Pass:string; Perm:TDBItemPerms);
begin
 if not Autorized then
 begin
 writeln('Please login. Hint: user auth <login> <password>');
 exit;
 end;
 if GetItemIndex(Login)<>Length(Self.Data) then
 begin
 Writeln('Login "'+Login+'" already reserved.');
 exit;
 end;
 if ((Self.Data[MyAccountID].item_perm<>tdbit_administrator)and((Perm=tdbit_administrator)or(Perm=tdbit_manager)))
 then begin
 WriteLn('You don''t have permissions for do that.');
 exit;
 end;
 SetLength(Self.Data,Length(Self.Data)+1);
 with Self.Data[length(Self.Data)-1] do
 begin
 id:=GetNextID;
 item_login:={EncryptMD5Login}(Login);
 crypted_password:=EncryptMD5Password(Pass);
 item_perm:=Perm;
 end;
 writeln('Success.');
end;

procedure TDB.Me;
begin
 if not Autorized then
 begin
 writeln('Login : null');
 writeln('Password hash : null');
 writeln('Permissions : null');
 exit;
 end;
 with Self.Data[MyAccountID] do
 begin
 writeln('Login : ',item_login);
 writeln('Password hash : ',crypted_password);
 write('Permissions : ');
 case item_perm of
 tdbit_user:writeln('User');
 tdbit_manager:writeln('Manager');
 tdbit_administrator:writeln('Administrator');
 end;
 end;
end;

procedure TDB.Find(s:string);
var
 i:cardinal;
 ResStack:array of cardinal;
begin
 SetLength(ResStack,0);
 if length(self.Data)=0 then
 begin
 writeln('Search return no results.');
 exit;
 end;
 for i:=0 to length(self.data)-1 do
 if pos(s,self.data[i].item_login)>0 then
 begin
 SetLength(ResStack,length(ResStack)+1);
 ResStack[Length(ResStack)-1]:=i;
 end;
 if length(ResStack)=0 then
 begin
 writeln('Search return no results.');
 exit;
 end;
 writeln('======================================');
 writeln('Search results:');
 writeln('======================================');
 for i:=0 to length(ResStack)-1 do
 begin
 case self.data[ResStack[i]].item_perm of
 tdbit_administrator:write('[ADMINISTRATOR] | ');
 tdbit_manager: write('[MANAGER] | ');
 tdbit_user: write('[USER] | ');
 end;
 writeln(self.data[ResStack[i]].item_login);
 end;
 writeln('======================================');
end;

var
 DB:TDB;

{= Commands ===================================================================}

procedure WriteHelp;
begin
 writeln('+===================================================+');
 writeln('| DBMgr help list: |');
 writeln('+===================================================+');
 writeln('| help |');
 writeln('| *show this box. |');
 writeln('+---------------------------------------------------+');
 writeln('| db create <file> |');
 writeln('| *create database. |');
 writeln('+---------------------------------------------------+');
 writeln('| db open <file> |');
 writeln('| *open database. |');
 writeln('+---------------------------------------------------+');
 writeln('| db save <file> |');
 writeln('| *save database. |');
 writeln('+---------------------------------------------------+');
 writeln('| db print |');
 writeln('| *output database to console. |');
 writeln('+---------------------------------------------------+');
 writeln('| user reg <name> <password> |');
 writeln('| *register new user. First user permisions set as |');
 writeln('| Administrator. |');
 writeln('+---------------------------------------------------+');
 writeln('| user auth <name> <password> |');
 writeln('| *auth into database. |');
 writeln('+---------------------------------------------------+');
 writeln('| user add <name> <password> <permissions> |');
 writeln('| *add new user in database. |');
 writeln('+---------------------------------------------------+');
 writeln('| user del <name> <password>               |');
 writeln('| *delete user from database.|');
 writeln('+---------------------------------------------------+');
 writeln('| user setlogin <login> <new login> |');
 writeln('| *change user login. |');
 writeln('+---------------------------------------------------+');
 writeln('| user setpassw <login> <new password> |');
 writeln('| *change user password. |');
 writeln('+---------------------------------------------------+');
 writeln('| user setdata <login> <data> |');
 writeln('| *change user data |');
 writeln('+---------------------------------------------------+');
 writeln('| user getdata <login> |');
 writeln('| *output user data to console |');
 writeln('+---------------------------------------------------+');
 writeln('| user me |');
 writeln('| *your session info. |');
 writeln('+---------------------------------------------------+');
 writeln('| user find <part of login> |');
 writeln('| *find all users wich logins concat request. |');
 writeln('+---------------------------------------------------+');
 writeln('| exit |');
 writeln('| *exit from DBMgr. |');
 writeln('+===================================================+');
 writeln('| Example: |');
 writeln('| 1. db create "test.db" |');
 writeln('| 2. user reg "Pimankin Alexandr" "My password" |');
 writeln('| 3. db save "test.db" |');
 writeln('+===================================================+');
 writeln('| Autor: Pimankin Alexandr, 2016. |');
 writeln('+===================================================+');
end;

{= CMD Parser & Interprer =====================================================}

const rword: array[0..1] of string=('','');

function smartlowercase(s:string):string;
var q:boolean;
begin
 result:='';
 q:=false;
 while length(s)<>0 do
 begin
 if (s[1]='#')and(q=false)
 then exit;
 if (s[1]='"')
 then q:=not q;
 if (q=true)
 then result:=
 result+s[1]
 else
 begin
 if not ((s[1]=s[2])and(s[1]=' ')) then
 result:=
 result+
 lowercase(s[1]);
 end;
 delete(s,1,1);
 end;
end;

function getfirststr(s:string):string;
var r:string;
begin
 r:='';
 delete(s,1,1);
 while (s[1]<>'"')and(length(s)<>0) do
 begin
 if s[1]<>'"' then begin r:=r+s[1];
 delete(s,1,1); end;
 end;
 result:='"'+r+'"';
end;

function getfirstobj(s:string):string;
begin
 result:='';
 if s[1]='"' then begin
 result:=getfirststr(s);
 exit;
 end;
 if length(s)<>0 then
 begin
 if pos(' ',s)>0 then result:=copy(s,1,pos(' ',s)-1) else result:=s;
 end;
end;

function getfirsttkn(s:string):string;
var x:integer;
begin
 s:=trim(s);
 for x:=0 to length(rword)-1 do
 if (copy(s,0,length(rword[x]))=rword[x])
 and (s[length(rword[x])+1]=' ') then
 begin
 result:=copy(s,0,length(rword[x]));
 if result='"' then result:=getfirststr(s);
 end
 else result:=getfirstobj(s);
end;

function cutfirsttkn(s:string):string;
begin
 s:=trim(s);
 delete(s,1,length(getfirsttkn(s)));
 result:=trim(s);
end;

function isstr(s:string):boolean;
begin
 result:=(s[1]='"')and(s[length(s)]='"')and
 (pos('"',copy(s,2,length(s)-2))=0);
end;

function getstr(s:string):string;
begin
 if isstr(s) then result:=copy(s,2,length(s)-2)
 else result:=s;
end;

var c:array of string;

procedure convert(str:string);
begin
 repeat
 setlength(c,length(c)+1);
 c[length(c)-1]:=getstr(getfirsttkn(str));
 str:=cutfirsttkn(str);
 until length(str)=0;
end;

procedure listen;
var s:string;
begin
 readln(s);
 s:=smartlowercase(s);
 s:=trim(s);
 convert(s);
end;

var cmds:array[0..17] of ansistring=(
'help',
'db',
'open', //db
'save', //db
'create', //db 'print', //db
'user',
'reg', //user
'auth', //user
'add', //user
'setlogin', //user
'setpassw', //user
'setdata', //user
'getdata', //user
'me', //user
'find', //user
'del', //user
'exit'
);

perms:array [0..2] of ansistring=('admin','manager','user');

procedure work;
begin
 if length(c)<>0 then
 begin
 case AnsiIndexStr(c[0],cmds) of
 0:writehelp;
 1: case AnsiIndexStr(c[1],cmds) of
 2:db.OpenDB(c[2]);
 3:db.SaveDB(c[2]);
 4:db.CreateDB(c[2]);
 5:db.Print;
 else writeln('Invalid use. Hint: db <open|save|create> <path>');
 end;
 6: case AnsiIndexStr(c[1],cmds) of
 7:db.Reg(c[2],c[3]);
 8:db.Auth(c[2],c[3]);
 9:db.AddUser(c[2],c[3],TDBItemPerms(AnsiIndexStr(c[4],perms)));
 10:db.SetNewLogin(c[2],c[3]);
 11:db.SetNewPass(c[2],c[3]);
 12:db.SetDataText(c[2],c[3]);
 13:writeln(db.GetDataText(c[2]));
 14:db.Me;
 15:db.find(c[2]);
 16:db.deleteitem(c[2]);
 else writeln('Invalid use.');
 end;
 17: halt;
 else writeln('Invalid comand, type "help" for see list of commands.');
 end;
 end;
end;

procedure prepare;
begin
 setlength(c,0);
end;

begin
 db.Autorized:=false;
 writeln('DBMgr. Type "help" for see list of commands.');
 repeat
 write('~>');
 prepare;
 listen;
 work;
 until false;
end.