cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-02-18 08:20:35 +01:00
Code Issues

- [fediverse] moved from a single database for a single account to a databases for each account.

Browse Source
This commit is contained in:
cage 2024-03-17 17:29:16 +01:00
parent c459c34dd1
commit 608eacda77
5 changed files with 54 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/api-client.lisp
View File

@ -26,9 +26,12 @@
(defparameter *client-lock* (make-lock)
"The Lock for prevent race conditions when accessing the mastodon server")
(define-constant +credentials-filename+ "client" :test #'string=
:documentation "The name of the file where
credentials are stored")
(defun credentials-filename ()
"The name of the file where credentials are stored."
(text-utils:strcat (swconf:current-username)
"@"
(swconf:current-server-name)
".credentials"))
(define-constant +protocol-scheme+ "https://" :test #'string=
:documentation "The scheme of the protocol that the
@ -70,14 +73,14 @@ initform."
(defun dump-credentials ()
"Serialize `*credential*' to disk"
(let ((resource-file (res:get-data-file +credentials-filename+)))
(let ((resource-file (res:get-data-file (credentials-filename))))
(fs:dump-sequence-to-file (serialize *credentials*)
resource-file)))
(defun forget-credentials ()
"Remove credentials data file"
(conditions:with-default-on-error (nil)
(let ((resource-file (res:get-data-file +credentials-filename+)))
(let ((resource-file (res:get-data-file (credentials-filename))))
(fs:delete-file-if-exists resource-file))))
(defun credentials-complete-p ()
@ -201,7 +204,7 @@ Returns nil if the user did not provided a server in the configuration file"
(ui:error-dialog-immediate
(format nil
(_ "Credential invalid. Try to remove ~a and restart the software to authenticate again")
(res:get-data-file +credentials-filename+))))))
(res:get-data-file (credentials-filename)))))))
(multiple-value-bind (server-socket server-port)
(open-catch-code-socket)
(setf *client* (make-default-client))
@ -964,7 +967,7 @@ and day is current time)"
(lambda (e)
(declare (ignore e))
(invoke-restart 'res:return-home-filename))))
(res:get-data-file +credentials-filename+))))
(res:get-data-file (credentials-filename)))))
(let ((resource-file (credentials-filename)))
(if (not (fs:file-exists-p resource-file))
(progn

4
src/constants.lisp
View File

@ -122,8 +122,8 @@ General Public License for more details."
(define-constant +mime-type-text+ "text/plain" :test #'string=)
(define-constant +db-file+ "db.sqlite3" :test #'string=
:documentation "the filename of the database")
(define-constant +db-file-extension+ "sqlite3" :test #'string=
:documentation "the extension filename of the databases")
(define-constant +json-true+ "true" :test #'string=)

16
src/db-utils.lisp
View File

@ -227,11 +227,25 @@ example:
(from table)))))
:ct))
(defun db-current-file-name ()
(concatenate 'string
(swconf:current-username)
"@"
(swconf:current-server-name)
"."
+db-file-extension+))
(defun db-path ()
(uiop:unix-namestring (concatenate 'string
(res:home-datadir)
"/"
+db-file+)))
(db-current-file-name))))
(defun db-path* ()
(uiop:unix-namestring (concatenate 'string
(res:home-datadir)
"/"
"db.sqlite3")))
(defun db-file-exists-p ()
(fs:file-exists-p (db-path)))

51
src/main.lisp
View File

@ -259,28 +259,29 @@ etc.) happened"
(defun main ()
"The entry point function of the program"
(let ((first-time-starting (not (db-utils:db-file-exists-p))))
(init-i18n)
(res:init)
(command-line:manage-opts)
(cond
(command-line:*start-dummy-server*
(gemini-dummy-server:start))
(command-line:*rpc-server-mode*
(db-utils:with-ready-database (:connect nil)
(rpc-server-init)))
(command-line:*rpc-client-mode*
(rpc-client-init)
(json-rpc-communication::start-client)
(client-main-window:init-main-window command-line:*net-address*))
(command-line:*print-lisp-dependencies*
(misc:all-program-dependencies t))
(command-line:*script-file*
(load-script-file))
(t
(let ((croatoan::*debugger-hook* #'(lambda (c h)
(declare (ignore h))
(c:end-screen)
(print c))))
(tui-init)
(run first-time-starting))))))
(init-i18n)
(res:init)
(command-line:manage-opts)
(cond
(command-line:*start-dummy-server*
(gemini-dummy-server:start))
(command-line:*rpc-server-mode*
(db-utils:with-ready-database (:connect nil)
(rpc-server-init)))
(command-line:*rpc-client-mode*
(rpc-client-init)
(json-rpc-communication::start-client)
(client-main-window:init-main-window command-line:*net-address*))
(command-line:*print-lisp-dependencies*
(misc:all-program-dependencies t))
(command-line:*script-file*
(load-script-file))
(t
(let ((croatoan::*debugger-hook* #'(lambda (c h)
(declare (ignore h))
(c:end-screen)
(print c))))
(tui-init)
(let ((first-time-starting (not (db-utils:db-file-exists-p))))
(run first-time-starting))))))

2
src/package.lisp
View File

@ -55,7 +55,7 @@
:+mime-type-png+
:+mime-type-html+
:+mime-type-text+
:+db-file+
:+db-file-extension+
:+fps+
:+command-window-height+
:+starting-init-file+