mirror of
https://codeberg.org/cage/tinmop/
synced 2025-02-16 08:00:35 +01:00
- [fediverse] ensured the posts do not contains non printable characters.
This commit is contained in:
cage
parent
3cc7da8184
commit
69b10a1b5d
168
src/db.lisp
168
src/db.lisp
@ -1215,6 +1215,9 @@ than (swconf:config-purge-history-days-offset) days in the past"
|
||||
(query ,update-query)
|
||||
(query ,insert-query)))))
|
||||
|
||||
(defun clean-chars (text)
|
||||
(clean-unprintable-chars (remove-corrupting-utf8-chars text)))
|
||||
|
||||
(defmethod update-db ((object tooter:account) &key &allow-other-keys)
|
||||
(with-accessors ((id tooter:id)
|
||||
(username tooter:username)
|
||||
@ -1234,55 +1237,53 @@ than (swconf:config-purge-history-days-offset) days in the past"
|
||||
(statuses-count tooter:statuses-count)
|
||||
(moved tooter:moved)
|
||||
(bot tooter:bot)) object
|
||||
(flet ((clean-chars (string)
|
||||
(remove-corrupting-utf8-chars string)))
|
||||
(let ((actual-created-at (decode-datetime-string created-at))
|
||||
(actual-botp (prepare-for-db bot :to-integer t))
|
||||
(actual-username (clean-chars username))
|
||||
(actual-display-name (clean-chars display-name))
|
||||
(actual-discoverable (prepare-for-db discoverable :to-integer t))
|
||||
(actual-locked (prepare-for-db locked :to-integer t))
|
||||
(actual-moved-id (if moved
|
||||
(prepare-for-db (tooter:id moved))
|
||||
(prepare-for-db nil))))
|
||||
(complete:initialize-complete-username-cache)
|
||||
(insert-or-update +table-account+
|
||||
(:id
|
||||
:username
|
||||
:acct
|
||||
:url
|
||||
:display-name
|
||||
:note
|
||||
:avatar
|
||||
:avatar-static
|
||||
:header
|
||||
:header-static
|
||||
:locked
|
||||
:discoverable
|
||||
:created-at
|
||||
:followers-count
|
||||
:following-count
|
||||
:statuses-count
|
||||
:moved-id
|
||||
:botp)
|
||||
(id
|
||||
actual-username
|
||||
account-name
|
||||
url
|
||||
actual-display-name
|
||||
note
|
||||
avatar
|
||||
avatar-static
|
||||
header
|
||||
header-static
|
||||
actual-locked
|
||||
actual-discoverable
|
||||
actual-created-at
|
||||
followers-count
|
||||
following-count
|
||||
statuses-count
|
||||
actual-moved-id
|
||||
actual-botp))))))
|
||||
(let ((actual-created-at (decode-datetime-string created-at))
|
||||
(actual-botp (prepare-for-db bot :to-integer t))
|
||||
(actual-username (clean-chars username))
|
||||
(actual-display-name (clean-chars display-name))
|
||||
(actual-discoverable (prepare-for-db discoverable :to-integer t))
|
||||
(actual-locked (prepare-for-db locked :to-integer t))
|
||||
(actual-moved-id (if moved
|
||||
(prepare-for-db (tooter:id moved))
|
||||
(prepare-for-db nil))))
|
||||
(complete:initialize-complete-username-cache)
|
||||
(insert-or-update +table-account+
|
||||
(:id
|
||||
:username
|
||||
:acct
|
||||
:url
|
||||
:display-name
|
||||
:note
|
||||
:avatar
|
||||
:avatar-static
|
||||
:header
|
||||
:header-static
|
||||
:locked
|
||||
:discoverable
|
||||
:created-at
|
||||
:followers-count
|
||||
:following-count
|
||||
:statuses-count
|
||||
:moved-id
|
||||
:botp)
|
||||
(id
|
||||
actual-username
|
||||
account-name
|
||||
url
|
||||
actual-display-name
|
||||
note
|
||||
avatar
|
||||
avatar-static
|
||||
header
|
||||
header-static
|
||||
actual-locked
|
||||
actual-discoverable
|
||||
actual-created-at
|
||||
followers-count
|
||||
following-count
|
||||
statuses-count
|
||||
actual-moved-id
|
||||
actual-botp)))))
|
||||
|
||||
(defmethod update-db ((object tooter:tag-history) &key (tag nil) &allow-other-keys)
|
||||
(assert (stringp tag))
|
||||
@ -1322,19 +1323,17 @@ than (swconf:config-purge-history-days-offset) days in the past"
|
||||
(username tooter:username)
|
||||
(account-name tooter:account-name)
|
||||
(url tooter:url)) object
|
||||
(flet ((clean-chars (string)
|
||||
(remove-corrupting-utf8-chars string)))
|
||||
(let ((actual-username (clean-chars username))
|
||||
(actual-acct (clean-chars account-name)))
|
||||
(insert-or-update +table-mention+
|
||||
(:id
|
||||
:username
|
||||
:acct
|
||||
:url)
|
||||
(id
|
||||
actual-username
|
||||
actual-acct
|
||||
url))))))
|
||||
(let ((actual-username (clean-chars username))
|
||||
(actual-acct (clean-chars account-name)))
|
||||
(insert-or-update +table-mention+
|
||||
(:id
|
||||
:username
|
||||
:acct
|
||||
:url)
|
||||
(id
|
||||
actual-username
|
||||
actual-acct
|
||||
url)))))
|
||||
|
||||
(defmethod update-db ((object tooter:status)
|
||||
&key
|
||||
@ -1368,28 +1367,29 @@ than (swconf:config-purge-history-days-offset) days in the past"
|
||||
(mentions tooter:mentions)) object
|
||||
(update-db account)
|
||||
(mapcar #'update-db mentions)
|
||||
(let* ((account-id (tooter:id account))
|
||||
(actual-created-at (decode-datetime-string created-at))
|
||||
(actual-application (prepare-for-db application))
|
||||
(tag-names (if tags
|
||||
(mapcar #'client:tag-name tags)
|
||||
'()))
|
||||
(actual-tags (concat-tags object))
|
||||
(actual-language (prepare-for-db language))
|
||||
(let* ((account-id (tooter:id account))
|
||||
(actual-created-at (decode-datetime-string created-at))
|
||||
(actual-application (prepare-for-db application))
|
||||
(tag-names (if tags
|
||||
(mapcar #'client:tag-name tags)
|
||||
'()))
|
||||
(actual-tags (concat-tags object))
|
||||
(actual-language (prepare-for-db language))
|
||||
;; use string-downcase as a workaround because tooter return an upcased keyword
|
||||
(actual-visibility (string-downcase (prepare-for-db visibility)))
|
||||
(actual-sensitive (prepare-for-db sensitive :to-integer t))
|
||||
(actual-favourited (prepare-for-db favourited :to-integer t))
|
||||
(actual-pinned (prepare-for-db pinned :to-integer t))
|
||||
(actual-reblogged (prepare-for-db reblogged :to-integer t))
|
||||
(actual-muted (prepare-for-db muted :to-integer t))
|
||||
(rendered-text (msg-utils:message-original->text-body content
|
||||
:try-decrypt nil))
|
||||
(reblog-id (if parent
|
||||
(prepare-for-db (tooter:id parent))
|
||||
(prepare-for-db nil)))
|
||||
(account-ignored-p (user-ignored-p account-id))
|
||||
(status-ignored-p (status-ignored-p id folder timeline)))
|
||||
(actual-visibility (string-downcase (prepare-for-db visibility)))
|
||||
(actual-sensitive (prepare-for-db sensitive :to-integer t))
|
||||
(actual-favourited (prepare-for-db favourited :to-integer t))
|
||||
(actual-pinned (prepare-for-db pinned :to-integer t))
|
||||
(actual-reblogged (prepare-for-db reblogged :to-integer t))
|
||||
(actual-muted (prepare-for-db muted :to-integer t))
|
||||
(actual-spoiler-text (clean-chars spoiler-text))
|
||||
(rendered-text (msg-utils:message-original->text-body content
|
||||
:try-decrypt nil))
|
||||
(reblog-id (if parent
|
||||
(prepare-for-db (tooter:id parent))
|
||||
(prepare-for-db nil)))
|
||||
(account-ignored-p (user-ignored-p account-id))
|
||||
(status-ignored-p (status-ignored-p id folder timeline)))
|
||||
(when (not (and skip-ignored-p
|
||||
(or status-ignored-p
|
||||
account-ignored-p)))
|
||||
@ -1426,7 +1426,7 @@ than (swconf:config-purge-history-days-offset) days in the past"
|
||||
rendered-text
|
||||
actual-visibility
|
||||
actual-sensitive
|
||||
spoiler-text
|
||||
actual-spoiler-text
|
||||
reblogs-count
|
||||
favourites-count
|
||||
url
|
||||
|
||||
@ -100,7 +100,7 @@
|
||||
(babel:string-to-octets s :errorp suppress-errors-p))
|
||||
|
||||
(defun clean-unprintable-chars (string)
|
||||
(cl-ppcre:scan-to-strings "[\\p{Letter}\\p{Number}\\p{Punctuation}]+" string))
|
||||
(cl-ppcre:regex-replace-all "\\p{C}" string ""))
|
||||
|
||||
(defun strcat (&rest chunks)
|
||||
(declare (optimize (debug 0) (safety 0) (speed 3)))
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user