From c50de0dca2c0898969012c04b93d3cee3abc58e1 Mon Sep 17 00:00:00 2001 From: cage Date: Fri, 15 Oct 2021 13:59:06 +0200 Subject: [PATCH] - added a script to delete old posts. --- scripts/delete-old-posts.lisp | 87 +++++++++++++++++++++++++++++++++++ src/api-client.lisp | 46 ++++++++++++++---- src/package.lisp | 2 + 3 files changed, 127 insertions(+), 8 deletions(-) create mode 100644 scripts/delete-old-posts.lisp diff --git a/scripts/delete-old-posts.lisp b/scripts/delete-old-posts.lisp new file mode 100644 index 0000000..dc714a7 --- /dev/null +++ b/scripts/delete-old-posts.lisp @@ -0,0 +1,87 @@ +;; delete old posts from the server (script for for tinmop) +;; Copyright © 2021 cage + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; usage: tinmop -e delete-old-posts.lisp and follow instructions + +;; IMPORTANT NOTE: this script will *permanently delete* the messages +;; (aka, post or toot) from your server beyond any recovering! Use +;; with caution! + +;; after configuring tinmop (https://www.autistici.org/interzona/tinmop.html) +;; tinmop -e delete-old-post.lisp + +(in-package :scripts) + +(define-constant +min-past-date+ "2021-08-01" :test #'string=) + +(defparameter *date-delete-treshold* "2021-10-01") + +(defun decode-date (post) + (multiple-value-bind (x y z day month year) + (decode-universal-time (tooter:created-at post) 0) + (declare (ignore x y z)) + (format nil + "~a-~2,'0d-~2,'0d" + year month day))) + +(defun date>= (a b) + (string>= a b)) + +(defun date< (a b) + (string< a b)) + +(defun list-posts (min-past-date show-progress &optional (max-id nil) (accum ())) + (let* ((username (swconf:config-username)) + (user-id (db:acct->id username)) + (posts (api-client:get-timeline (ui::timeline->kind db:+home-timeline+) + :local t + :max-id max-id + :limit 10)) + (sorted-posts (api-client:sort-id< posts)) + (min-post-id (tooter:id (first sorted-posts))) + (min-post-date (decode-date (first sorted-posts))) + (my-posts (remove-if-not (lambda (a) + (string= (tooter:id (tooter:account a)) + user-id)) + posts))) + (if (and posts + (date>= min-post-date min-past-date)) + (progn + (when show-progress + (format t "downloaded until ~a~%" min-post-date)) + (list-posts min-past-date t min-post-id (append my-posts accum))) + accum))) + +(defun main () + (client:init) + (client:authorize) + (format t "This client has been authorized.~%") + (format t "Please provide the post's maximum creation date.~%") + (format t "Posts with date older then the provided one will be deleted~%") + (write-string "Maximum date (format \"YYY-MM-DD\"): ") + (finish-output) + (let* ((input-date (read-line)) + (*date-delete-treshold* (db-utils:encode-datetime-string input-date))) + (when (yes-or-no-p "deleting posts older than ~s. Continue?" input-date) + (if *date-delete-treshold* + (let ((posts (list-posts +min-past-date+ t))) + (loop for post in posts when (date< (decode-date post) *date-delete-treshold*) do + (let ((post-contents (with-output-to-string (stream) (tooter::present post stream)))) + (format t "deleting~2%~a~%" post-contents) + (api-client:delete-status (tooter:id post)))))) + (format *error-output* "Date ~s is not valid, exiting.~%" input-date))))) + +(main) diff --git a/src/api-client.lisp b/src/api-client.lisp index 066e981..1ed8970 100644 --- a/src/api-client.lisp +++ b/src/api-client.lisp @@ -298,14 +298,17 @@ Returns nil if the user did not provided a server in the configuration file" - min-id starts getting messages newer than this id - since-id cut the messages got starting from this id - limit gets a maimum of messages up to this value." - (tooter:timeline *client* - kind - :local local - :only-media only-media - :max-id max-id - :since-id since-id - :min-id min-id - :limit limit)) + (misc:dbg "kind?? ~a" kind) + (assert (or (string-equal kind db:+federated-timeline+) + (string-equal kind db:+home-timeline+))) + (tooter:timeline *client* + kind + :local local + :only-media only-media + :max-id max-id + :since-id since-id + :min-id min-id + :limit limit)) (defun status-id< (a b) (string< (tooter:id a) @@ -476,6 +479,30 @@ database." "Find user identified by username" (tooter:search-accounts *client* username :limit limit :resolve resolve)) +(defun-api-call find-results (query + &key + (account-id nil) + (max-id nil) + (min-id nil) + (kind "statuses") + (exclude-unreviewed nil) + (resolve t) + (limit 20) + (offset 0) + (following nil)) + "Search stuff, default statuses" + (tooter:find-results *client* + query + :account-id account-id + :max-id max-id + :min-id min-id + :kind kind + :exclude-unreviewed exclude-unreviewed + :resolve resolve + :limit limit + :offset offset + :following following)) + (defun-api-call follow-user (user-id) "Follow user identified by user-id" (tooter:follow *client* user-id)) @@ -584,6 +611,9 @@ i.e. `message-root-id' is root for said tree." "Delete a conversation identified by `conversation-id'" (tooter:delete-conversation *client* conversation-id)) +(defun-api-call delete-status (status-id) + (tooter:delete-status *client* status-id)) + (defun-api-call make-report (account-id status-id comment forward) "Report an user (identified by `account-id') and a status (identified by `status-id') to and instance admin, if `forward' diff --git a/src/package.lisp b/src/package.lisp index 4a77680..ce47b94 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1568,6 +1568,7 @@ :send-status :get-status-context :search-user + :find-results :follow-user :unfollow-user :follow-requests @@ -1583,6 +1584,7 @@ :expand-conversations-tree :make-report :delete-conversation + :delete-status :get-activity :application-credentials :bookmarks