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

src/api-client.lisp

@@ -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=
+(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=
                  :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

src/constants.lisp

@@ -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=
+(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=)
 

src/db-utils.lisp

@@ -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)))

src/main.lisp

@@ -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)
-    (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))))))

src/package.lisp

@@ -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+