cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2024-12-17 23:18:28 +01:00
Code Issues

- prevented authorization of client if no server nameahs been provided

Browse Source 
by the user in the config file.
This commit is contained in:
cage 2021-01-12 20:28:21 +01:00
parent 766367369c
commit 72254f981a
3 changed files with 121 additions and 138 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

246
src/api-client.lisp
View File

@ -158,106 +158,117 @@ authorizations was performed with success."
(strcat "http://127.0.0.1:" (to-s port))) (strcat "http://127.0.0.1:" (to-s port)))
(defun make-default-client () (defun make-default-client ()
"Convenience funtion to build a `api-client' instance" "Convenience funtion to build a `api-client' instance
(make-instance 'api-client
:base (make-base-slot) Returns nil if the user did not provided a server in the configuration file"
:name +program-name+)) (when (text-utils:string-not-empty-p (swconf:config-server-name))
(make-instance 'api-client
:base (make-base-slot)
:name +program-name+)))
(defun client-valid-p ()
*client*)
(defun authorize () (defun authorize ()
"Perform all the steps to authorize this application" "Perform all the steps to authorize this application"
(setf *client* (make-default-client)) (setf *client* (make-default-client))
(if (credentials-complete-p) (when (client-valid-p)
(progn (if (credentials-complete-p)
(copy-credentials-to-client) (progn
(tooter:authorize *client*) (copy-credentials-to-client)
(handler-case (tooter:authorize *client*)
(application-credentials) (handler-case
(error () (application-credentials)
(ui:error-dialog-immediate (error ()
(format nil (ui:error-dialog-immediate
(_ "Credential invalid. Try to remove ~a and restart the software to authenticate again.") (format nil
(res:get-data-file +credentials-filename+)))))) (_ "Credential invalid. Try to remove ~a and restart the software to authenticate again.")
(multiple-value-bind (server-socket server-port) (res:get-data-file +credentials-filename+))))))
(open-catch-code-socket) (multiple-value-bind (server-socket server-port)
(setf *client* (make-default-client)) (open-catch-code-socket)
(setf (tooter:redirect *client*) (make-redirect-url server-port)) (setf *client* (make-default-client))
#+debug-mode (misc:dbg "Client ~a not authorized" *client*) (setf (tooter:redirect *client*) (make-redirect-url server-port))
(multiple-value-bind (a url) #+debug-mode (misc:dbg "Client ~a not authorized" *client*)
(tooter:authorize *client*) (multiple-value-bind (a url)
(declare (ignore a)) (tooter:authorize *client*)
(let* ((dialog-msg (authorize-dialog-message)) (declare (ignore a))
(save-item (_ "Save address")) (let* ((dialog-msg (authorize-dialog-message))
(open-item (_ "Open address")) (save-item (_ "Save address"))
(cancel-item (_ "Cancel")) (open-item (_ "Open address"))
(choosen (ui:info-dialog-immediate (format nil "~a~%~a" dialog-msg url) (cancel-item (_ "Cancel"))
:buttons (list save-item (choosen (ui:info-dialog-immediate (format nil "~a~%~a" dialog-msg url)
open-item :buttons (list save-item
cancel-item) open-item
:append-ok-button nil))) cancel-item)
(labels ((on-got-authorization-code (value) :append-ok-button nil)))
(handler-case (labels ((on-got-authorization-code (value)
(progn (handler-case
(tooter:authorize *client* value) (progn
(copy-credentials-from-client) (tooter:authorize *client* value)
(dump-credentials) (copy-credentials-from-client)
(ui:notify (_ "This client has been authorized"))) (dump-credentials)
(tooter:request-failed (error) (ui:notify (_ "This client has been authorized")))
(ui:request-error-window error)) (tooter:request-failed (error)
(error () (ui:request-error-window error))
(ui:error-dialog-immediate (_ "Got a generic error when registering client"))))) (error ()
(notify-file-saved (filepath) (ui:error-dialog-immediate (_ "Got a generic error when registering client")))))
(ui:notify (format nil (_ "File ~a saved") filepath))) (notify-file-saved (filepath)
(save-credentials () (ui:notify (format nil (_ "File ~a saved") filepath)))
(let* ((message (_ "Please enter below the file where to save the address")) (save-credentials ()
(filepath (ui:input-dialog-immediate message))) (let* ((message (_ "Please enter below the file where to save the address"))
(cond (filepath (ui:input-dialog-immediate message)))
((null filepath) (cond
(save-credentials)) ((null filepath)
((fs:file-exists-p filepath) (save-credentials))
(if (ui:confirm-file-overwrite-dialog-immediate filepath) ((fs:file-exists-p filepath)
(progn (if (ui:confirm-file-overwrite-dialog-immediate filepath)
(fs:dump-sequence-to-file url filepath) (progn
(notify-file-saved filepath)) (fs:dump-sequence-to-file url filepath)
(save-credentials))) (notify-file-saved filepath))
(t (save-credentials)))
(fs:dump-sequence-to-file url filepath) (t
(notify-file-saved filepath)))))) (fs:dump-sequence-to-file url filepath)
(cond (notify-file-saved filepath))))))
((string= choosen open-item) (cond
(os-utils:xdg-open url) ((string= choosen open-item)
(if server-socket (os-utils:xdg-open url)
(let ((authcode (catch-auth-code server-socket))) (if server-socket
(on-got-authorization-code authcode)) (let ((authcode (catch-auth-code server-socket)))
(ui:error-dialog-immediate (_ "Error: was not able to create server socket to listen for authorization code")))) (on-got-authorization-code authcode))
((string= choosen save-item) (ui:error-dialog-immediate (_ "Error: was not able to create server socket to listen for authorization code"))))
(save-credentials))))))))) ((string= choosen save-item)
(save-credentials))))))))))
(defun-w-lock favourite-status (status-id) (defmacro defun-api-call (name parameters &body body)
*client-lock* (multiple-value-bind (remaining-forms declarations doc-string)
(alexandria:parse-body body :documentation t)
`(defun-w-lock ,name ,parameters *client-lock*
,doc-string
,declarations
(when (client-valid-p)
,@remaining-forms))))
(defun-api-call favourite-status (status-id)
"Favourite a status identified by `status-id'" "Favourite a status identified by `status-id'"
(tooter:favourite *client* (tooter:favourite *client*
status-id)) status-id))
(defun-w-lock unfavourite-status (status-id) (defun-api-call unfavourite-status (status-id)
*client-lock*
"Unfavourite a status identified by `status-id'" "Unfavourite a status identified by `status-id'"
(tooter:unfavourite *client* (tooter:unfavourite *client*
status-id)) status-id))
(defun-w-lock reblog-status (status-id) (defun-api-call reblog-status (status-id)
*client-lock*
"Reblog a status identified by `status-id'" "Reblog a status identified by `status-id'"
(tooter:reblog *client* (tooter:reblog *client*
status-id)) status-id))
(defun-w-lock unreblog-status (status-id) (defun-api-call unreblog-status (status-id)
*client-lock*
"Reblog a status identified by `status-id'" "Reblog a status identified by `status-id'"
(tooter:unreblog *client* (tooter:unreblog *client*
status-id)) status-id))
(defun-w-lock get-timeline (kind &key local only-media max-id since-id min-id (limit 20)) (defun-api-call get-timeline (kind &key local only-media max-id since-id min-id (limit 20))
*client-lock*
"Get messages (status) belonging to a timeline "Get messages (status) belonging to a timeline
- kind: one of - kind: one of
@ -295,7 +306,7 @@ authorizations was performed with success."
:folder folder))) :folder folder)))
(program-events:push-event add-fetched-event)))) (program-events:push-event add-fetched-event))))
(defun-w-lock update-timeline (timeline (defun-api-call update-timeline (timeline
kind kind
folder folder
&key &key
@ -307,7 +318,6 @@ authorizations was performed with success."
min-id min-id
(recover-count 0) (recover-count 0)
(limit 20)) (limit 20))
*client-lock*
"Update a timeline, this function will fetch new messages and generate and event to "Update a timeline, this function will fetch new messages and generate and event to
update the program reflectings the changes in the timeline (saves update the program reflectings the changes in the timeline (saves
messages in the database etc.)" messages in the database etc.)"
@ -345,8 +355,7 @@ authorizations was performed with success."
program-events:+maximum-event-priority+) program-events:+maximum-event-priority+)
(program-events:push-event event))) (program-events:push-event event)))
(defun-w-lock get-timeline-tag (tag &key min-id (limit 20)) (defun-api-call get-timeline-tag (tag &key min-id (limit 20))
*client-lock*
"Gets messages that contains tags identified by parameter `tag'" "Gets messages that contains tags identified by parameter `tag'"
(tooter:timeline-tag *client* (tooter:timeline-tag *client*
tag tag
@ -357,11 +366,10 @@ authorizations was performed with success."
:min-id min-id :min-id min-id
:limit limit)) :limit limit))
(defun-w-lock update-timeline-tag (tag folder &key (defun-api-call update-timeline-tag (tag folder &key
(recover-count 0) (recover-count 0)
min-id min-id
(limit 20)) (limit 20))
*client-lock*
"Update a tag timeline, this function will fetch new messages (that "Update a tag timeline, this function will fetch new messages (that
contains tag `tag') and generate and event to update the program contains tag `tag') and generate and event to update the program
reflectings the changes in the timeline (saves messages in the reflectings the changes in the timeline (saves messages in the
@ -402,8 +410,7 @@ become an emty string (\"\")
"" ""
nil)))) nil))))
(defun-w-lock update-subscribed-tags (all-tags all-paginations &key (limit 20)) (defun-api-call update-subscribed-tags (all-tags all-paginations &key (limit 20))
*client-lock*
"Update all tage in the list `all-tags'" "Update all tage in the list `all-tags'"
(loop (loop
for tag in all-tags for tag in all-tags
@ -415,8 +422,7 @@ become an emty string (\"\")
:limit limit :limit limit
:min-id max-id)))) :min-id max-id))))
(defun-w-lock fetch-remote-status (status-id) (defun-api-call fetch-remote-status (status-id)
*client-lock*
"Fetch a single status identified by status-id and generate an event "Fetch a single status identified by status-id and generate an event
`fetch-remote-status-event' that, in turn will save the status to the `fetch-remote-status-event' that, in turn will save the status to the
database." database."
@ -425,18 +431,16 @@ database."
:payload status))) :payload status)))
(program-events:push-event event))) (program-events:push-event event)))
(defun-w-lock get-remote-status (status-id) (defun-api-call get-remote-status (status-id)
*client-lock*
"Get a single status identifird bu status-id" "Get a single status identifird bu status-id"
(ignore-errors (ignore-errors
(tooter:find-status *client* status-id))) (tooter:find-status *client* status-id)))
(defun-w-lock get-status-context (status-id) *client-lock* (defun-api-call get-status-context (status-id)
"Get a parent and a child of a status (identified by status-id), if exists" "Get a parent and a child of a status (identified by status-id), if exists"
(tooter:context *client* status-id)) (tooter:context *client* status-id))
(defun-w-lock send-status (content in-reply-to-id attachments subject visibility) (defun-api-call send-status (content in-reply-to-id attachments subject visibility)
*client-lock*
"Send a status "Send a status
- content the actual text of the message - content the actual text of the message
- in-reply-to-id status-id of the message you are replying to (or nil - in-reply-to-id status-id of the message you are replying to (or nil
@ -452,36 +456,30 @@ database."
:spoiler-text subject :spoiler-text subject
:visibility visibility)) :visibility visibility))
(defun-w-lock search-user (username &key (limit 1)) (defun-api-call search-user (username &key (limit 1))
*client-lock*
"Find user identified by username" "Find user identified by username"
(tooter:search-accounts *client* username :limit limit)) (tooter:search-accounts *client* username :limit limit))
(defun-w-lock follow-user (user-id) (defun-api-call follow-user (user-id)
*client-lock*
"Follow user identified by user-id" "Follow user identified by user-id"
(tooter:follow *client* user-id)) (tooter:follow *client* user-id))
(defun-w-lock unfollow-user (user-id) (defun-api-call unfollow-user (user-id)
*client-lock*
"Unfollow user identified by user-id" "Unfollow user identified by user-id"
(tooter:unfollow *client* user-id)) (tooter:unfollow *client* user-id))
(defun-w-lock follow-requests () (defun-api-call follow-requests ()
*client-lock*
"Gets the request tio follow the user of this client" "Gets the request tio follow the user of this client"
(let ((requests (tooter:follow-requests *client*))) (let ((requests (tooter:follow-requests *client*)))
(values requests (values requests
(mapcar #'tooter:account-name requests)))) (mapcar #'tooter:account-name requests))))
(defun-w-lock accept-follow-request (user-id) (defun-api-call accept-follow-request (user-id)
*client-lock*
"Accept a follow request from user identified by `user-id'" "Accept a follow request from user identified by `user-id'"
(when user-id (when user-id
(tooter:accept-request *client* user-id))) (tooter:accept-request *client* user-id)))
(defun-w-lock reject-follow-request (user-id) (defun-api-call reject-follow-request (user-id)
*client-lock*
"Reject a follow request from user identified by `user-id'" "Reject a follow request from user identified by `user-id'"
(when user-id (when user-id
(tooter:reject-request *client* user-id))) (tooter:reject-request *client* user-id)))
@ -526,13 +524,12 @@ database."
"Status id of the root of a conversation tree" "Status id of the root of a conversation tree"
(tooter:id (root object))) (tooter:id (root object)))
(defun-w-lock conversations (&key (defun-api-call conversations (&key
(min-id nil) (min-id nil)
(since-id nil) (since-id nil)
(max-id nil) (max-id nil)
(limit 20) (limit 20)
(root-only nil)) (root-only nil))
*client-lock*
"Get trees of conversations "Get trees of conversations
- max-id get status until this id - max-id get status until this id
- min-id starts getting messages newer than this id - min-id starts getting messages newer than this id
@ -567,13 +564,11 @@ database."
i.e. `message-root-id' is root for said tree." i.e. `message-root-id' is root for said tree."
(expand-status-tree message-root-id)) (expand-status-tree message-root-id))
(defun-w-lock delete-conversation (conversation-id) (defun-api-call delete-conversation (conversation-id)
*client-lock*
"Delete a conversation identified by `conversation-id'" "Delete a conversation identified by `conversation-id'"
(tooter:delete-conversation *client* conversation-id)) (tooter:delete-conversation *client* conversation-id))
(defun-w-lock make-report (account-id status-id comment forward) (defun-api-call make-report (account-id status-id comment forward)
*client-lock*
"Report an user (identified by `account-id') and a "Report an user (identified by `account-id') and a
status (identified by `status-id') to and instance admin, if `forward' status (identified by `status-id') to and instance admin, if `forward'
is non nil the report will be forwarded to the non local admin where is non nil the report will be forwarded to the non local admin where
@ -584,23 +579,20 @@ the account belongs."
:comment comment :comment comment
:forward forward)) :forward forward))
(defun-w-lock get-activity () (defun-api-call get-activity ()
*client-lock*
"Get instance stats" "Get instance stats"
(tooter:get-activity *client*)) (tooter:get-activity *client*))
(defun-w-lock application-credentials () (defun-api-call application-credentials ()
*client-lock*
"Verify the credentials to log into the server with the instance, "Verify the credentials to log into the server with the instance,
returns nil if the credentials are invalid" returns nil if the credentials are invalid"
(tooter:verify-app-credentials *client*)) (tooter:verify-app-credentials *client*))
(defun-w-lock bookmarks (&key (defun-api-call bookmarks (&key
(min-id nil) (min-id nil)
(since-id nil) (since-id nil)
(max-id nil) (max-id nil)
(limit 20)) (limit 20))
*client-lock*
"List Bookmarked statuses. "List Bookmarked statuses.
- max-id get status until this id - max-id get status until this id
- min-id starts getting messages newer than this id - min-id starts getting messages newer than this id
@ -612,26 +604,22 @@ returns nil if the credentials are invalid"
:max-id max-id :max-id max-id
:limit limit)) :limit limit))
(defun-w-lock bookmark (id) (defun-api-call bookmark (id)
*client-lock*
"Bookmark a status identified by `id'" "Bookmark a status identified by `id'"
(assert (stringp id)) (assert (stringp id))
(tooter:bookmark *client* id)) (tooter:bookmark *client* id))
(defun-w-lock unbookmark (id) (defun-api-call unbookmark (id)
*client-lock*
"Unbokmark a status identified by `id'" "Unbokmark a status identified by `id'"
(assert (stringp id)) (assert (stringp id))
(tooter:unbookmark *client* id)) (tooter:unbookmark *client* id))
(defun-w-lock polls (id) (defun-api-call polls (id)
*client-lock*
"Get a poll identified by `id'" "Get a poll identified by `id'"
(assert (stringp id)) (assert (stringp id))
(tooter:polls *client* id)) (tooter:polls *client* id))
(defun-w-lock poll-vote (poll-id choices) (defun-api-call poll-vote (poll-id choices)
*client-lock*
"Vote for a poll identified by `poll-id', choices is a list of "Vote for a poll identified by `poll-id', choices is a list of
numerical indices identifying the option voting for" numerical indices identifying the option voting for"
(assert (every (lambda (a) (assert (every (lambda (a)
@ -640,14 +628,13 @@ numerical indices identifying the option voting for"
choices)) choices))
(tooter:poll-vote *client* poll-id choices)) (tooter:poll-vote *client* poll-id choices))
(defun-w-lock get-notifications (&key (defun-api-call get-notifications (&key
(max-id nil) (max-id nil)
(min-id nil) (min-id nil)
(since-id nil) (since-id nil)
(limit 10) (limit 10)
(exclude-types nil) (exclude-types nil)
(account-id nil)) (account-id nil))
*client-lock*
"get notifications "get notifications
- max-id get notification until this id - max-id get notification until this id
@ -669,8 +656,7 @@ the latest 15 mentions)."
(get-notifications :max-id max-id (get-notifications :max-id max-id
:exclude-types excluded-types)) :exclude-types excluded-types))
(defun-w-lock delete-notification (notification-id) (defun-api-call delete-notification (notification-id)
*client-lock*
"Delete a notification identified by `notification-id'" "Delete a notification identified by `notification-id'"
(tooter:delete-notification *client* notification-id)) (tooter:delete-notification *client* notification-id))

12
src/api-pleroma.lisp
View File

@ -79,20 +79,16 @@ media `media'. Returns a `chat-message' instance"
message-id) message-id)
:http-method :delete))) :http-method :delete)))
(defun-w-lock get-chat-messages (chat-id min-id) (api-client:defun-api-call get-chat-messages (chat-id min-id)
api-client:*client-lock*
(fetch-chat-messages api-client:*client* chat-id :min-id min-id)) (fetch-chat-messages api-client:*client* chat-id :min-id min-id))
(defun-w-lock get-chats () (api-client:defun-api-call get-chats ()
api-client:*client-lock*
(get-all-chats api-client:*client*)) (get-all-chats api-client:*client*))
(defun-w-lock post-on-chat (chat-id message) (api-client:defun-api-call post-on-chat (chat-id message)
api-client:*client-lock*
(if (cl-ppcre:scan "^/" message) (if (cl-ppcre:scan "^/" message)
(api-pleroma:post-chat-message api-client:*client* chat-id nil message) (api-pleroma:post-chat-message api-client:*client* chat-id nil message)
(api-pleroma:post-chat-message api-client:*client* chat-id message nil))) (api-pleroma:post-chat-message api-client:*client* chat-id message nil)))
(defun-w-lock create-new-chat (user-id) (api-client:defun-api-call create-new-chat (user-id)
api-client:*client-lock*
(create-chat api-client:*client* user-id)) (create-chat api-client:*client* user-id))

1
src/package.lisp
View File

@ -1421,6 +1421,7 @@
:*client-lock* :*client-lock*
:forget-credentials :forget-credentials
:authorize :authorize
:defun-api-call
:favourite-status :favourite-status
:unfavourite-status :unfavourite-status
:reblog-status :reblog-status