mirror of https://codeberg.org/cage/tinmop/
- [fediverse] moved from a single database for a single account to a databases for each account.
This commit is contained in:
parent
c459c34dd1
commit
608eacda77
|
@ -26,9 +26,12 @@
|
||||||
(defparameter *client-lock* (make-lock)
|
(defparameter *client-lock* (make-lock)
|
||||||
"The Lock for prevent race conditions when accessing the mastodon server")
|
"The Lock for prevent race conditions when accessing the mastodon server")
|
||||||
|
|
||||||
(define-constant +credentials-filename+ "client" :test #'string=
|
(defun credentials-filename ()
|
||||||
:documentation "The name of the file where
|
"The name of the file where credentials are stored."
|
||||||
credentials are stored")
|
(text-utils:strcat (swconf:current-username)
|
||||||
|
"@"
|
||||||
|
(swconf:current-server-name)
|
||||||
|
".credentials"))
|
||||||
|
|
||||||
(define-constant +protocol-scheme+ "https://" :test #'string=
|
(define-constant +protocol-scheme+ "https://" :test #'string=
|
||||||
:documentation "The scheme of the protocol that the
|
:documentation "The scheme of the protocol that the
|
||||||
|
@ -70,14 +73,14 @@ initform."
|
||||||
|
|
||||||
(defun dump-credentials ()
|
(defun dump-credentials ()
|
||||||
"Serialize `*credential*' to disk"
|
"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*)
|
(fs:dump-sequence-to-file (serialize *credentials*)
|
||||||
resource-file)))
|
resource-file)))
|
||||||
|
|
||||||
(defun forget-credentials ()
|
(defun forget-credentials ()
|
||||||
"Remove credentials data file"
|
"Remove credentials data file"
|
||||||
(conditions:with-default-on-error (nil)
|
(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))))
|
(fs:delete-file-if-exists resource-file))))
|
||||||
|
|
||||||
(defun credentials-complete-p ()
|
(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
|
(ui:error-dialog-immediate
|
||||||
(format nil
|
(format nil
|
||||||
(_ "Credential invalid. Try to remove ~a and restart the software to authenticate again")
|
(_ "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)
|
(multiple-value-bind (server-socket server-port)
|
||||||
(open-catch-code-socket)
|
(open-catch-code-socket)
|
||||||
(setf *client* (make-default-client))
|
(setf *client* (make-default-client))
|
||||||
|
@ -964,7 +967,7 @@ and day is current time)"
|
||||||
(lambda (e)
|
(lambda (e)
|
||||||
(declare (ignore e))
|
(declare (ignore e))
|
||||||
(invoke-restart 'res:return-home-filename))))
|
(invoke-restart 'res:return-home-filename))))
|
||||||
(res:get-data-file +credentials-filename+))))
|
(res:get-data-file (credentials-filename)))))
|
||||||
(let ((resource-file (credentials-filename)))
|
(let ((resource-file (credentials-filename)))
|
||||||
(if (not (fs:file-exists-p resource-file))
|
(if (not (fs:file-exists-p resource-file))
|
||||||
(progn
|
(progn
|
||||||
|
|
|
@ -122,8 +122,8 @@ General Public License for more details."
|
||||||
|
|
||||||
(define-constant +mime-type-text+ "text/plain" :test #'string=)
|
(define-constant +mime-type-text+ "text/plain" :test #'string=)
|
||||||
|
|
||||||
(define-constant +db-file+ "db.sqlite3" :test #'string=
|
(define-constant +db-file-extension+ "sqlite3" :test #'string=
|
||||||
:documentation "the filename of the database")
|
:documentation "the extension filename of the databases")
|
||||||
|
|
||||||
(define-constant +json-true+ "true" :test #'string=)
|
(define-constant +json-true+ "true" :test #'string=)
|
||||||
|
|
||||||
|
|
|
@ -227,11 +227,25 @@ example:
|
||||||
(from table)))))
|
(from table)))))
|
||||||
:ct))
|
:ct))
|
||||||
|
|
||||||
|
(defun db-current-file-name ()
|
||||||
|
(concatenate 'string
|
||||||
|
(swconf:current-username)
|
||||||
|
"@"
|
||||||
|
(swconf:current-server-name)
|
||||||
|
"."
|
||||||
|
+db-file-extension+))
|
||||||
|
|
||||||
(defun db-path ()
|
(defun db-path ()
|
||||||
(uiop:unix-namestring (concatenate 'string
|
(uiop:unix-namestring (concatenate 'string
|
||||||
(res:home-datadir)
|
(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 ()
|
(defun db-file-exists-p ()
|
||||||
(fs:file-exists-p (db-path)))
|
(fs:file-exists-p (db-path)))
|
||||||
|
|
|
@ -259,28 +259,29 @@ etc.) happened"
|
||||||
|
|
||||||
(defun main ()
|
(defun main ()
|
||||||
"The entry point function of the program"
|
"The entry point function of the program"
|
||||||
(let ((first-time-starting (not (db-utils:db-file-exists-p))))
|
(init-i18n)
|
||||||
(init-i18n)
|
(res:init)
|
||||||
(res:init)
|
(command-line:manage-opts)
|
||||||
(command-line:manage-opts)
|
(cond
|
||||||
(cond
|
(command-line:*start-dummy-server*
|
||||||
(command-line:*start-dummy-server*
|
(gemini-dummy-server:start))
|
||||||
(gemini-dummy-server:start))
|
(command-line:*rpc-server-mode*
|
||||||
(command-line:*rpc-server-mode*
|
(db-utils:with-ready-database (:connect nil)
|
||||||
(db-utils:with-ready-database (:connect nil)
|
(rpc-server-init)))
|
||||||
(rpc-server-init)))
|
(command-line:*rpc-client-mode*
|
||||||
(command-line:*rpc-client-mode*
|
(rpc-client-init)
|
||||||
(rpc-client-init)
|
(json-rpc-communication::start-client)
|
||||||
(json-rpc-communication::start-client)
|
(client-main-window:init-main-window command-line:*net-address*))
|
||||||
(client-main-window:init-main-window command-line:*net-address*))
|
(command-line:*print-lisp-dependencies*
|
||||||
(command-line:*print-lisp-dependencies*
|
(misc:all-program-dependencies t))
|
||||||
(misc:all-program-dependencies t))
|
(command-line:*script-file*
|
||||||
(command-line:*script-file*
|
(load-script-file))
|
||||||
(load-script-file))
|
(t
|
||||||
(t
|
(let ((croatoan::*debugger-hook* #'(lambda (c h)
|
||||||
(let ((croatoan::*debugger-hook* #'(lambda (c h)
|
(declare (ignore h))
|
||||||
(declare (ignore h))
|
(c:end-screen)
|
||||||
(c:end-screen)
|
(print c))))
|
||||||
(print c))))
|
|
||||||
(tui-init)
|
(tui-init)
|
||||||
(run first-time-starting))))))
|
(let ((first-time-starting (not (db-utils:db-file-exists-p))))
|
||||||
|
(run first-time-starting))))))
|
||||||
|
|
|
@ -55,7 +55,7 @@
|
||||||
:+mime-type-png+
|
:+mime-type-png+
|
||||||
:+mime-type-html+
|
:+mime-type-html+
|
||||||
:+mime-type-text+
|
:+mime-type-text+
|
||||||
:+db-file+
|
:+db-file-extension+
|
||||||
:+fps+
|
:+fps+
|
||||||
:+command-window-height+
|
:+command-window-height+
|
||||||
:+starting-init-file+
|
:+starting-init-file+
|
||||||
|
|
Loading…
Reference in New Issue