420 lines
15 KiB
Plaintext
420 lines
15 KiB
Plaintext
Module Database
|
|
EnableExplicit
|
|
|
|
UseSQLiteDatabase()
|
|
|
|
; Private constants
|
|
#DB = 0
|
|
|
|
; Private procedures
|
|
Procedure.s SHA256(text.s)
|
|
Protected *Buf, Len.i, Hash.s
|
|
Len = StringByteLength(text, #PB_UTF8)
|
|
If Len = 0 : ProcedureReturn "" : EndIf
|
|
*Buf = AllocateMemory(Len)
|
|
If *Buf
|
|
PokeS(*Buf, text, -1, #PB_UTF8 | #PB_String_NoZero)
|
|
Hash = LCase(Fingerprint(*Buf, Len, #PB_Cipher_SHA2, 256))
|
|
FreeMemory(*Buf)
|
|
EndIf
|
|
ProcedureReturn Hash
|
|
EndProcedure
|
|
|
|
Procedure.s GenerateHex(Bytes.i)
|
|
Protected Token.s, i
|
|
For i = 1 To Bytes
|
|
Token + RSet(Hex(Random(255)), 2, "0")
|
|
Next
|
|
ProcedureReturn LCase(Token)
|
|
EndProcedure
|
|
|
|
Procedure.s JSONEscape(s.s)
|
|
s = ReplaceString(s, "\", "\\")
|
|
s = ReplaceString(s, ~"\"", ~"\\\"")
|
|
s = ReplaceString(s, ~"\n", ~"\\n")
|
|
s = ReplaceString(s, ~"\r", ~"\\r")
|
|
s = ReplaceString(s, ~"\t", ~"\\t")
|
|
ProcedureReturn s
|
|
EndProcedure
|
|
|
|
;- Public procedures
|
|
Procedure Init(Path.s)
|
|
Protected TempFile.i
|
|
|
|
If FileSize(Path) = -1
|
|
TempFile = CreateFile(#PB_Any, Path)
|
|
CloseFile(TempFile)
|
|
EndIf
|
|
|
|
If Not OpenDatabase(#DB, Path, "", "", #PB_Database_SQLite)
|
|
ProcedureReturn #False
|
|
EndIf
|
|
|
|
DatabaseUpdate(#DB, "CREATE TABLE IF NOT EXISTS users (id INTEGER PRIMARY KEY AUTOINCREMENT, username TEXT UNIQUE NOT NULL COLLATE NOCASE, password_hash TEXT NOT NULL, salt TEXT NOT NULL, created_at INTEGER NOT NULL)")
|
|
DatabaseUpdate(#DB, "CREATE TABLE IF NOT EXISTS sessions (token TEXT PRIMARY KEY, user_id INTEGER NOT NULL, username TEXT NOT NULL, created_at INTEGER NOT NULL, expires_at INTEGER NOT NULL)")
|
|
DatabaseUpdate(#DB, "CREATE TABLE IF NOT EXISTS installed_apps (id INTEGER PRIMARY KEY, user_id INTEGER NOT NULL, app_id TEXT NOT NULL, manifest TEXT NOT NULL, permissions TEXT NOT NULL, installed_at INTEGER NOT NULL, UNIQUE(user_id, app_id))")
|
|
|
|
ProcedureReturn #True
|
|
EndProcedure
|
|
|
|
Procedure Close()
|
|
If IsDatabase(#DB)
|
|
CloseDatabase(#DB)
|
|
EndIf
|
|
EndProcedure
|
|
|
|
; User management
|
|
Procedure UserCount()
|
|
Protected Count = 0
|
|
If DatabaseQuery(#DB, "SELECT COUNT(*) FROM users")
|
|
If NextDatabaseRow(#DB) : Count = GetDatabaseLong(#DB, 0) : EndIf
|
|
FinishDatabaseQuery(#DB)
|
|
EndIf
|
|
ProcedureReturn Count
|
|
EndProcedure
|
|
|
|
Procedure FindUser(Username.s)
|
|
Protected ID = 0
|
|
SetDatabaseString(#DB, 0, Username)
|
|
If DatabaseQuery(#DB, "SELECT id FROM users WHERE username = ? COLLATE NOCASE")
|
|
If NextDatabaseRow(#DB) : ID = GetDatabaseLong(#DB, 0) : EndIf
|
|
FinishDatabaseQuery(#DB)
|
|
EndIf
|
|
ProcedureReturn ID
|
|
EndProcedure
|
|
|
|
Procedure CreateUser(Username.s, Password.s)
|
|
Protected Salt.s = GenerateHex(16)
|
|
Protected Hash.s = SHA256(Password + Salt)
|
|
SetDatabaseString(#DB, 0, Username)
|
|
SetDatabaseString(#DB, 1, Hash)
|
|
SetDatabaseString(#DB, 2, Salt)
|
|
SetDatabaseLong(#DB, 3, Date())
|
|
ProcedureReturn DatabaseUpdate(#DB, "INSERT INTO users (username, password_hash, salt, created_at) VALUES (?, ?, ?, ?)")
|
|
EndProcedure
|
|
|
|
Procedure ChangePassword(UserID.i, NewPassword.s)
|
|
Protected Salt.s = GenerateHex(16)
|
|
Protected Hash.s = SHA256(NewPassword + Salt)
|
|
SetDatabaseString(#DB, 0, Hash)
|
|
SetDatabaseString(#DB, 1, Salt)
|
|
SetDatabaseLong(#DB, 2, UserID)
|
|
DatabaseUpdate(#DB, "UPDATE users SET password_hash = ?, salt = ? WHERE id = ?")
|
|
EndProcedure
|
|
|
|
Procedure.s ValidateCredentials(Username.s, Password.s)
|
|
Protected StoredUser.s, Hash.s, Salt.s
|
|
SetDatabaseString(#DB, 0, Username)
|
|
If DatabaseQuery(#DB, "SELECT username, password_hash, salt FROM users WHERE username = ? COLLATE NOCASE")
|
|
If NextDatabaseRow(#DB)
|
|
StoredUser = GetDatabaseString(#DB, 0)
|
|
Hash = GetDatabaseString(#DB, 1)
|
|
Salt = GetDatabaseString(#DB, 2)
|
|
EndIf
|
|
FinishDatabaseQuery(#DB)
|
|
EndIf
|
|
If StoredUser = "" : ProcedureReturn "" : EndIf
|
|
If SHA256(Password + Salt) = Hash : ProcedureReturn StoredUser : EndIf
|
|
ProcedureReturn ""
|
|
EndProcedure
|
|
|
|
Procedure.s CreateSession(UserID.i, Username.s)
|
|
Protected Token.s = GenerateHex(32)
|
|
Protected Now.i = Date()
|
|
SetDatabaseString(#DB, 0, Token)
|
|
SetDatabaseLong(#DB, 1, UserID)
|
|
SetDatabaseString(#DB, 2, Username)
|
|
SetDatabaseLong(#DB, 3, Now)
|
|
SetDatabaseLong(#DB, 4, Now + #SESSION_DURATION)
|
|
DatabaseUpdate(#DB, "INSERT OR REPLACE INTO sessions (token, user_id, username, created_at, expires_at) VALUES (?, ?, ?, ?, ?)")
|
|
ProcedureReturn Token
|
|
EndProcedure
|
|
|
|
Procedure.s ValidateSession(Token.s)
|
|
Protected Username.s = ""
|
|
If Len(Token) <> 64 : ProcedureReturn "" : EndIf
|
|
SetDatabaseString(#DB, 0, Token)
|
|
SetDatabaseLong(#DB, 1, Date())
|
|
If DatabaseQuery(#DB, "SELECT username FROM sessions WHERE token = ? AND expires_at > ?")
|
|
If NextDatabaseRow(#DB) : Username = GetDatabaseString(#DB, 0) : EndIf
|
|
FinishDatabaseQuery(#DB)
|
|
EndIf
|
|
ProcedureReturn Username
|
|
EndProcedure
|
|
|
|
Procedure DeleteSession(Token.s)
|
|
SetDatabaseString(#DB, 0, Token)
|
|
DatabaseUpdate(#DB, "DELETE FROM sessions WHERE token = ?")
|
|
EndProcedure
|
|
|
|
Procedure CleanExpiredSessions()
|
|
SetDatabaseLong(#DB, 0, Date())
|
|
DatabaseUpdate(#DB, "DELETE FROM sessions WHERE expires_at <= ?")
|
|
EndProcedure
|
|
|
|
;- File system
|
|
Procedure.i FSInit()
|
|
Protected Now.i = Date()
|
|
DatabaseUpdate(#DB, "CREATE TABLE IF NOT EXISTS fs_nodes (id INTEGER PRIMARY KEY AUTOINCREMENT, owner_id INTEGER NOT NULL, parent_id INTEGER, name TEXT NOT NULL COLLATE NOCASE, is_dir INTEGER NOT NULL DEFAULT 0, mime_type TEXT NOT NULL DEFAULT 'application/octet-stream', size INTEGER NOT NULL DEFAULT 0, created_at INTEGER NOT NULL, modified_at INTEGER NOT NULL)")
|
|
DatabaseUpdate(#DB, "CREATE UNIQUE INDEX IF NOT EXISTS idx_fs_unique ON fs_nodes(parent_id, name)")
|
|
DatabaseUpdate(#DB, "CREATE INDEX IF NOT EXISTS idx_fs_owner ON fs_nodes(owner_id)")
|
|
|
|
; Shared root - owner_id 0, one row, idempotent
|
|
SetDatabaseLong(#DB, 0, Now)
|
|
SetDatabaseLong(#DB, 1, Now)
|
|
DatabaseUpdate(#DB, "INSERT OR IGNORE INTO fs_nodes (owner_id, parent_id, name, is_dir, created_at, modified_at) VALUES (0, NULL, 'shared', 1, ?, ?)")
|
|
|
|
ProcedureReturn #True
|
|
EndProcedure
|
|
|
|
Procedure.i FSGetOrCreateHome(UserID.i)
|
|
Protected ID.i = 0, Now.i
|
|
SetDatabaseLong(#DB, 0, UserID)
|
|
If DatabaseQuery(#DB, "SELECT id FROM fs_nodes WHERE owner_id = ? AND parent_id IS NULL")
|
|
If NextDatabaseRow(#DB) : ID = GetDatabaseLong(#DB, 0) : EndIf
|
|
FinishDatabaseQuery(#DB)
|
|
EndIf
|
|
If ID = 0
|
|
Now = Date()
|
|
SetDatabaseLong(#DB, 0, UserID)
|
|
SetDatabaseLong(#DB, 1, Now)
|
|
SetDatabaseLong(#DB, 2, Now)
|
|
DatabaseUpdate(#DB, "INSERT INTO fs_nodes (owner_id, parent_id, name, is_dir, created_at, modified_at) VALUES (?, NULL, 'home', 1, ?, ?)")
|
|
If DatabaseQuery(#DB, "SELECT last_insert_rowid()")
|
|
If NextDatabaseRow(#DB) : ID = GetDatabaseLong(#DB, 0) : EndIf
|
|
FinishDatabaseQuery(#DB)
|
|
EndIf
|
|
EndIf
|
|
ProcedureReturn ID
|
|
EndProcedure
|
|
|
|
Procedure.i FSResolve(UserID.i, Path.s)
|
|
Protected CurrentID.i, SegCount.i, i.i, Seg.s, CandID.i
|
|
|
|
While Left(Path, 1) = "/" : Path = Mid(Path, 2) : Wend
|
|
While Right(Path, 1) = "/" : Path = Left(Path, Len(Path) - 1) : Wend
|
|
|
|
If Path = "shared" Or Left(Path, 7) = "shared/"
|
|
If DatabaseQuery(#DB, "SELECT id FROM fs_nodes WHERE owner_id = 0 AND parent_id IS NULL")
|
|
If NextDatabaseRow(#DB) : CurrentID = GetDatabaseLong(#DB, 0) : EndIf
|
|
FinishDatabaseQuery(#DB)
|
|
EndIf
|
|
If Path = "shared" : ProcedureReturn CurrentID : EndIf
|
|
Path = Mid(Path, 8) ; strip "shared/"
|
|
Else
|
|
CurrentID = FSGetOrCreateHome(UserID)
|
|
If Path = "" : ProcedureReturn CurrentID : EndIf
|
|
EndIf
|
|
|
|
If CurrentID = 0 : ProcedureReturn 0 : EndIf
|
|
|
|
SegCount = CountString(Path, "/") + 1
|
|
For i = 1 To SegCount
|
|
Seg = StringField(Path, i, "/")
|
|
If Seg = "" : Continue : EndIf
|
|
CandID = 0
|
|
SetDatabaseLong(#DB, 0, CurrentID)
|
|
SetDatabaseString(#DB, 1, Seg)
|
|
If DatabaseQuery(#DB, "SELECT id FROM fs_nodes WHERE parent_id = ? AND name = ?")
|
|
If NextDatabaseRow(#DB) : CandID = GetDatabaseLong(#DB, 0) : EndIf
|
|
FinishDatabaseQuery(#DB)
|
|
EndIf
|
|
If CandID = 0 : ProcedureReturn 0 : EndIf
|
|
CurrentID = CandID
|
|
Next
|
|
|
|
ProcedureReturn CurrentID
|
|
EndProcedure
|
|
|
|
Procedure.s FSList(NodeID.i)
|
|
Protected JSON.s = "[", First.i = #True
|
|
SetDatabaseLong(#DB, 0, NodeID)
|
|
If DatabaseQuery(#DB, "SELECT id, name, is_dir, mime_type, size, modified_at FROM fs_nodes WHERE parent_id = ? ORDER BY is_dir DESC, name")
|
|
While NextDatabaseRow(#DB)
|
|
If Not First : JSON + "," : EndIf
|
|
JSON + ~"{\"id\":" + GetDatabaseLong(#DB, 0) +
|
|
~",\"name\":\"" + JSONEscape(GetDatabaseString(#DB, 1)) + ~"\"" +
|
|
~",\"is_dir\":" + GetDatabaseLong(#DB, 2) +
|
|
~",\"mime_type\":\"" + JSONEscape(GetDatabaseString(#DB, 3)) + ~"\"" +
|
|
~",\"size\":" + GetDatabaseLong(#DB, 4) +
|
|
~",\"modified_at\":" + GetDatabaseLong(#DB, 5) + "}"
|
|
First = #False
|
|
Wend
|
|
FinishDatabaseQuery(#DB)
|
|
EndIf
|
|
ProcedureReturn JSON + "]"
|
|
EndProcedure
|
|
|
|
Procedure.s FSStat(NodeID.i)
|
|
Protected JSON.s = ""
|
|
SetDatabaseLong(#DB, 0, NodeID)
|
|
If DatabaseQuery(#DB, "SELECT id, owner_id, parent_id, name, is_dir, mime_type, size, created_at, modified_at FROM fs_nodes WHERE id = ?")
|
|
If NextDatabaseRow(#DB)
|
|
JSON = ~"{\"id\":" + GetDatabaseLong(#DB, 0) +
|
|
~",\"owner_id\":" + GetDatabaseLong(#DB, 1) +
|
|
~",\"parent_id\":" + GetDatabaseLong(#DB, 2) +
|
|
~",\"name\":\"" + JSONEscape(GetDatabaseString(#DB, 3)) + ~"\"" +
|
|
~",\"is_dir\":" + GetDatabaseLong(#DB, 4) +
|
|
~",\"mime_type\":\"" + JSONEscape(GetDatabaseString(#DB, 5)) + ~"\"" +
|
|
~",\"size\":" + GetDatabaseLong(#DB, 6) +
|
|
~",\"created_at\":" + GetDatabaseLong(#DB, 7) +
|
|
~",\"modified_at\":" + GetDatabaseLong(#DB, 8) + "}"
|
|
EndIf
|
|
FinishDatabaseQuery(#DB)
|
|
EndIf
|
|
ProcedureReturn JSON
|
|
EndProcedure
|
|
|
|
Procedure.i FSGetOwner(NodeID.i, *IsDir.Integer = 0)
|
|
Protected OwnerID.i = -1
|
|
SetDatabaseLong(#DB, 0, NodeID)
|
|
If DatabaseQuery(#DB, "SELECT owner_id, is_dir FROM fs_nodes WHERE id = ?")
|
|
If NextDatabaseRow(#DB)
|
|
OwnerID = GetDatabaseLong(#DB, 0)
|
|
If *IsDir : *IsDir\i = GetDatabaseLong(#DB, 1) : EndIf
|
|
EndIf
|
|
FinishDatabaseQuery(#DB)
|
|
EndIf
|
|
ProcedureReturn OwnerID
|
|
EndProcedure
|
|
|
|
Procedure.i FSMkdir(UserID.i, ParentID.i, Name.s)
|
|
Protected Now.i = Date(), ID.i = 0
|
|
SetDatabaseLong(#DB, 0, UserID)
|
|
SetDatabaseLong(#DB, 1, ParentID)
|
|
SetDatabaseString(#DB, 2, Name)
|
|
SetDatabaseLong(#DB, 3, Now)
|
|
SetDatabaseLong(#DB, 4, Now)
|
|
DatabaseUpdate(#DB, "INSERT OR IGNORE INTO fs_nodes (owner_id, parent_id, name, is_dir, created_at, modified_at) VALUES (?, ?, ?, 1, ?, ?)")
|
|
SetDatabaseLong(#DB, 0, ParentID)
|
|
SetDatabaseString(#DB, 1, Name)
|
|
If DatabaseQuery(#DB, "SELECT id FROM fs_nodes WHERE parent_id = ? AND name = ?")
|
|
If NextDatabaseRow(#DB) : ID = GetDatabaseLong(#DB, 0) : EndIf
|
|
FinishDatabaseQuery(#DB)
|
|
EndIf
|
|
ProcedureReturn ID
|
|
EndProcedure
|
|
|
|
Procedure.i FSCreateFile(UserID.i, ParentID.i, Name.s, MimeType.s)
|
|
Protected Now.i = Date(), ID.i = 0
|
|
SetDatabaseLong(#DB, 0, UserID)
|
|
SetDatabaseLong(#DB, 1, ParentID)
|
|
SetDatabaseString(#DB, 2, Name)
|
|
SetDatabaseString(#DB, 3, MimeType)
|
|
SetDatabaseLong(#DB, 4, Now)
|
|
SetDatabaseLong(#DB, 5, Now)
|
|
DatabaseUpdate(#DB, "INSERT OR IGNORE INTO fs_nodes (owner_id, parent_id, name, is_dir, mime_type, created_at, modified_at) VALUES (?, ?, ?, 0, ?, ?, ?)")
|
|
SetDatabaseLong(#DB, 0, ParentID)
|
|
SetDatabaseString(#DB, 1, Name)
|
|
If DatabaseQuery(#DB, "SELECT id FROM fs_nodes WHERE parent_id = ? AND name = ?")
|
|
If NextDatabaseRow(#DB) : ID = GetDatabaseLong(#DB, 0) : EndIf
|
|
FinishDatabaseQuery(#DB)
|
|
EndIf
|
|
ProcedureReturn ID
|
|
EndProcedure
|
|
|
|
Procedure FSUpdateFile(NodeID.i, Size.i)
|
|
SetDatabaseLong(#DB, 0, Size)
|
|
SetDatabaseLong(#DB, 1, Date())
|
|
SetDatabaseLong(#DB, 2, NodeID)
|
|
DatabaseUpdate(#DB, "UPDATE fs_nodes SET size = ?, modified_at = ? WHERE id = ?")
|
|
EndProcedure
|
|
|
|
Procedure FSDelete(NodeID.i)
|
|
Protected NewList ChildIDs.i()
|
|
SetDatabaseLong(#DB, 0, NodeID)
|
|
If DatabaseQuery(#DB, "SELECT id FROM fs_nodes WHERE parent_id = ?")
|
|
While NextDatabaseRow(#DB)
|
|
AddElement(ChildIDs()) : ChildIDs() = GetDatabaseLong(#DB, 0)
|
|
Wend
|
|
FinishDatabaseQuery(#DB)
|
|
EndIf
|
|
ForEach ChildIDs()
|
|
FSDelete(ChildIDs())
|
|
Next
|
|
SetDatabaseLong(#DB, 0, NodeID)
|
|
DatabaseUpdate(#DB, "DELETE FROM fs_nodes WHERE id = ?")
|
|
EndProcedure
|
|
|
|
Procedure FSMove(NodeID.i, NewParentID.i, NewName.s)
|
|
SetDatabaseLong(#DB, 0, NewParentID)
|
|
SetDatabaseString(#DB, 1, NewName)
|
|
SetDatabaseLong(#DB, 2, Date())
|
|
SetDatabaseLong(#DB, 3, NodeID)
|
|
DatabaseUpdate(#DB, "UPDATE fs_nodes SET parent_id = ?, name = ?, modified_at = ? WHERE id = ?")
|
|
EndProcedure
|
|
|
|
;- Applications
|
|
Procedure.i AppInstall(UserID.i, AppID.s, Manifest.s, Permissions.s)
|
|
SetDatabaseLong(#DB, 0, UserID)
|
|
SetDatabaseString(#DB, 1, AppID)
|
|
SetDatabaseString(#DB, 2, Manifest)
|
|
SetDatabaseString(#DB, 3, Permissions)
|
|
SetDatabaseLong(#DB, 4, Date())
|
|
ProcedureReturn DatabaseUpdate(#DB, "INSERT OR REPLACE INTO installed_apps (user_id, app_id, manifest, permissions, installed_at) VALUES (?, ?, ?, ?, ?)")
|
|
EndProcedure
|
|
|
|
Procedure AppUninstall(UserID.i, AppID.s)
|
|
SetDatabaseLong(#DB, 0, UserID)
|
|
SetDatabaseString(#DB, 1, AppID)
|
|
DatabaseUpdate(#DB, "DELETE FROM installed_apps WHERE user_id = ? AND app_id = ?")
|
|
EndProcedure
|
|
|
|
Procedure.i AppExists(UserID.i, AppID.s)
|
|
Protected Exists.i = #False
|
|
SetDatabaseLong(#DB, 0, UserID)
|
|
SetDatabaseString(#DB, 1, AppID)
|
|
If DatabaseQuery(#DB, "SELECT id FROM installed_apps WHERE user_id = ? AND app_id = ?")
|
|
Exists = Bool(NextDatabaseRow(#DB))
|
|
FinishDatabaseQuery(#DB)
|
|
EndIf
|
|
ProcedureReturn Exists
|
|
EndProcedure
|
|
|
|
Procedure.s AppGetPermissions(UserID.i, AppID.s)
|
|
Protected Result.s = ""
|
|
SetDatabaseLong(#DB, 0, UserID)
|
|
SetDatabaseString(#DB, 1, AppID)
|
|
If DatabaseQuery(#DB, "SELECT permissions FROM installed_apps WHERE user_id = ? AND app_id = ?")
|
|
If NextDatabaseRow(#DB) : Result = GetDatabaseString(#DB, 0) : EndIf
|
|
FinishDatabaseQuery(#DB)
|
|
EndIf
|
|
ProcedureReturn Result
|
|
EndProcedure
|
|
|
|
Procedure.s AppList(UserID.i)
|
|
Protected JSON.s = "[", First.i = #True
|
|
Protected AppID.s, Manifest.s, Perms.s, InstalledAt.i
|
|
|
|
SetDatabaseLong(#DB, 0, UserID)
|
|
If Not DatabaseQuery(#DB, "SELECT app_id, manifest, permissions, installed_at FROM installed_apps WHERE user_id = ? ORDER BY installed_at ASC")
|
|
ProcedureReturn "[]"
|
|
EndIf
|
|
|
|
While NextDatabaseRow(#DB)
|
|
AppID = GetDatabaseString(#DB, 0)
|
|
Manifest = GetDatabaseString(#DB, 1)
|
|
Perms = GetDatabaseString(#DB, 2)
|
|
InstalledAt = GetDatabaseLong(#DB, 3)
|
|
|
|
If Not First : JSON + "," : EndIf
|
|
First = #False
|
|
|
|
; Manifest and permissions are inlined as-is (already valid JSON)
|
|
JSON + ~"{\"app_id\":\"" + JSONEscape(AppID) + ~"\"" +
|
|
~",\"manifest\":" + Manifest +
|
|
~",\"permissions\":" + Perms +
|
|
~",\"installed_at\":" + InstalledAt + "}"
|
|
Wend
|
|
|
|
FinishDatabaseQuery(#DB)
|
|
ProcedureReturn JSON + "]"
|
|
EndProcedure
|
|
|
|
EndModule
|
|
|
|
; IDE Options = PureBasic 6.30 (Windows - x64)
|
|
; CursorPosition = 37
|
|
; Folding = BAAAA+
|
|
; EnableXP
|
|
; DPIAware |