From 08ba2769abb7a36817a725d30d64cfd36f5bcf32 Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Fri, 11 Mar 2022 08:35:55 -0600 Subject: separated app and lib modules, -osicat dep, +packages.lisp --- app/app.lisp | 291 +++++++++++++++++++++++++ app/package.lisp | 5 + clpmfile.lock | 7 - lib/lib.lisp | 451 +++++++++++++++++++++++++++++++++++++++ lib/oneliner.lisp | 59 ++++++ lib/package.lisp | 20 ++ lib/prompt.lisp | 30 +++ lib/running.lisp | 47 +++++ lib/state.lisp | 62 ++++++ lib/term.lisp | 15 ++ lib/util.lisp | 37 ++++ oneliners.cli.asd | 13 +- src/app.lisp | 294 -------------------------- src/lib.lisp | 622 ------------------------------------------------------ src/prompt.lisp | 33 --- 15 files changed, 1025 insertions(+), 961 deletions(-) create mode 100644 app/app.lisp create mode 100644 app/package.lisp create mode 100644 lib/lib.lisp create mode 100644 lib/oneliner.lisp create mode 100644 lib/package.lisp create mode 100644 lib/prompt.lisp create mode 100644 lib/running.lisp create mode 100644 lib/state.lisp create mode 100644 lib/term.lisp create mode 100644 lib/util.lisp delete mode 100644 src/app.lisp delete mode 100644 src/lib.lisp delete mode 100644 src/prompt.lisp diff --git a/app/app.lisp b/app/app.lisp new file mode 100644 index 0000000..44a5f97 --- /dev/null +++ b/app/app.lisp @@ -0,0 +1,291 @@ +;;;; app.lisp -- definition of CLI options and entry point. + +;; Copyright (C) 2022 Colin Okay + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU Affero 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 Affero General Public License for more details. + +;; You should have received a copy of the GNU Affero General Public License +;; along with this program. If not, see . + + + +(in-package :oneliners.cli.app) + +;;; VERSION +(defparameter +ol-version+ "0.6.0") + +;;; HELP TEXTS +(defparameter +invite-help-text+ + " +New contributor accounts are added to the your oneliners server by +redeeming invite tokens. + +When the --redeem option is passed, the ARGS section is expected to be +three items long, and is interpreted as TOKEN USERNAME PASSWORD. E.g.: + + ol --redeem PHONEYTOKEN c00lhacker my1337pw + +Would attempt to make a new user named c00lhacker with password +my1337pw.") + +(defparameter +oneliners-variables-help-text+ +" +Oneliners may contain variables. There are positional variables and +named variables. + +POSITIONAL VARIABLES appear in the oneliner as a # followed by a +number, which must 1 or greater. For example: + + echo Hello #1, Happy #2 + +The #1 and #2 are a positional variables. You might call the above +like + + ol --run 8 Doofus Tuesday + +Assuming that the above oneliner has ID 8, then \"Hello Doofus, + Happy Tuesday\" would print to the console. + +NAMED VARIABLES are similar. They appear in the oneliner as # followed +by a letter in the Roman alphabet, followed by any sequence of Roman +letters, numbers, or the symbol _. For example: + + echo Hello #name you get a #thing + +The #name and #thing are named variables. You might call the above like so: + + ol --run 3 name=Goober thing='sock in the nose' + +Which should print \"Hello Goober you get a sock in the nose\". + +Finally, you can MIX POSITIONAL AND NAMED VARIABLES so long as, when +you run the oneliner, all positional variables appear first. +") + +(defparameter +configure-your-edtior+ + "Adding explainations for oneliners, either with --add or --edit, +will use a default system editor. If you do not like the default +editor you may configure it by the exporting the EDITOR environment +variable to whatever you prefer. + +E.g. in your .bashrc you might put + +export EDITOR=/usr/bin/zile + +") + + +;;; CLON SYNOPSIS DEFINITION + +(defsynopsis (:postfix "[ARGUMENTS ...]") + (group (:header "SEARCH OPTIONS") + (text :contents "By default, ARGUMENTS are interpeted as search terms for oneliners. For example:") + (text :contents "$ ol grep awk # search for oneliners involving both grep and awk") + (text :contents " ") + + (lispobj :long-name "limit" + :argument-type :optional + :argument-name "NUMBER" + :default-value 10 + :description "The maximum number of results to return." + :typespec 'integer) + (flag :long-name "all-flagged" + :description "Request that only flagged oneliners are returned. Without any ARGUMENTS, simply returns all flagged oneliners.") + (flag :long-name "not-flagged" + :description "Request that no flagged oneliners are returned with the search results. Does nothing without ARGUMENTS") + (flag :long-name "newest" + :description "Return newest oneliners that match. Without any ARGUMENTS, simply returns the newest oneliners.")) + (text :contents " ") + (group (:header "EXECUTION OPTIONS") + (text :contents "Several options override the default interpretation of ARGUMENTS.") + (text :contents "Execution options interpret the first argument as the identifier of a oneliner: ") + (text :contents "$ ol [MORE ARGUMENTS...]") + (text :contents " ") + (flag :long-name "run" + :description "Executes a oneliner by NAME or ID. See also help topic 'variables'.") + (flag :long-name "clip" + :description "Like --run, but puts the oneliner into the clipboard.")) + (text :contents " ") + (group (:header "OTHER OPTIONS") + (flag :long-name "show" + :description "View all information for the oneliner given by NAME or ID") + (lispobj :long-name "timeout" + :argument-type :optional + :argument-name "SECONDS" + :default-value 2 + :typespec 'integer + :description "How long to wait for standard output before giving up.")) + (text :contents " ") + (group (:header "HELP OPTIONS") + (flag :long-name "whois" + :description "View information about a contributor. The first argument is a contributor handle.") + (flag :long-name "help" + :description "Print help for a topic. Topics: wiki, account, invites, variables, editor") + (flag :long-name "version" + :description "Print the client's version")) + (group (:header "Advanced Options" :hidden t) + (flag :long-name "clear-cache" + :description "Clears all cached search results from your system.")) + (group (:header "Editor" :hidden t) + (text :contents +configure-your-edtior+)) + (group (:header "Variables" :hidden t) + (text :contents +oneliners-variables-help-text+)) + (group (:header "Wiki" :hidden t) + (text :contents "Options For Managing Oneliners") + (flag :long-name "add" + :description "Intaractively add a oneliner and update the wiki.") + (flag :long-name "edit" + :description "Interactively edit a oneliner and update the wiki.") + (flag :long-name "flag" + :description "Flag a oneliner for review.") + (flag :long-name "unflag" + :description "If you have admin priviliges, unflag a oneliner.") + (flag :long-name "lock" + :description "If you have admin priviliges, lock a oneliner from being edited.") + (flag :long-name "unlock" + :description "If you have admin priviliges, unlock a oneliner.")) + (group (:header "Account" :hidden t) + (text :contents "Options for Managing Your Contributor Account") + (flag :long-name "login" + :description "Attempt to login to your contributor account. ARGS are interpreted as USERNAME PASSWORD.") + (flag :long-name "logout" + :description "Revoke your own access token.") + (flag :long-name "change-password" + :description "Change your password. ARGS are interpreted as CURRENTPW NEWPW NEWPWAGAIN") + (flag :long-name "change-signature" + :description "Change your contributor signature. You will be prompted.")) + (group (:header "Invites" :hidden t) + (text :contents " ") + (text :contents "Options For Making Invites and Redeeming Tokens") + (flag :long-name "invite" + :description "Request an invite token to send to a friend.") + (flag :long-name "redeem" + :description "Redeem an invite token.") + (text :contents +invite-help-text+))) + +;;; HELPERS + +(defun find-group-with-header (header) + "This function should be built in. Is it? How to know? The +documentation is both extensive and trash. Any manual that expects +you to go to sleep with it at night is written for the author more +than the users." + (loop for item in (net.didierverna.clon::items *synopsis*) + when (and (typep item 'net.didierverna.clon::group) + (string-equal header (net.didierverna.clon::header item))) + return item)) + +(defun prepare-oneliner-arguments (arguments) + "Takes a list of arguments, as gathered by (REMAINDER), and returns + a list that looks like (ID-OR-NAME . ARGS) where ID-OR-NAME is + either an integer or a string." + (a:if-let (id (parse-integer (first arguments) :junk-allowed t)) + (cons id (rest arguments)) + arguments)) + +;;; MAIN ENTRY POINT + +(defun main () + "Entry point for our standalone application." + (make-context) + (handler-case + (let ((arguments (remainder))) + (cond + ((getopt :long-name "version") + (format t "Oneliner CLI Version: ~a~%" +ol-version+)) + ((getopt :long-name "help") + (if (and arguments (find-group-with-header (first arguments))) + (help :item (find-group-with-header (first arguments))) + (help)) + (uiop:quit)) + ((getopt :long-name "whois") + (assert (first arguments) () "--whois requires an argument, a user handle.") + (cli::show-contributor (first arguments))) + + ((getopt :long-name "redeem") + (assert (= 3 (length arguments)) () "--redeem requires exatly three arguments.") + (destructuring-bind (token name pass) arguments + (cli::redeem-invite token name pass))) + + ((getopt :long-name "login") + (assert (= 2 (length arguments)) () "--login requires exactly two arguments.") + (destructuring-bind (user pass) arguments + (cli::login user pass))) + + ((getopt :long-name "change-password") + (assert (= 3 (length arguments)) () "--change-password requires exactly three arguments." ) + (destructuring-bind (current new repeated) arguments + (cli::change-pw current new repeated))) + + ((getopt :long-name "change-signature") + (cli::change-signature)) + + ((getopt :long-name "invite") + (cli::request-invite-code)) + + ((getopt :long-name "logout") + (cli::revoke-access)) + + ((getopt :long-name "add") + (cli::add-new-oneliner)) + + ((and (null arguments) (getopt :long-name "all-flagged")) + (cli::all-flagged-oneliners (getopt :long-name "limit"))) + + ((and (null arguments) (getopt :long-name "newest")) + (cli::newest-oneliners (getopt :long-name "limit"))) + + ((getopt :long-name "clear-cache") + (cli::wipe-cache)) + + (arguments + (destructuring-bind (id-or-name . args) (prepare-oneliner-arguments arguments) + (cond + ((getopt :long-name "flag") + (cli::flag-item id-or-name )) + ((getopt :long-name "unflag") + (cli::unflag-item id-or-name)) + ((getopt :long-name "lock") + (cli::lock-item id-or-name )) + ((getopt :long-name "unlock") + (cli::unlock-item id-or-name )) + ((getopt :long-name "edit") + (cli::edit-item id-or-name )) + ((getopt :long-name "show") + (cli::print-item-explanation id-or-name)) + ((getopt :long-name "clip") + (cli::run-item id-or-name args + :force-clip t + :timeout (getopt :long-name "timeout"))) + ((getopt :long-name "run") + (cli::run-item id-or-name args + :timeout (getopt :long-name "timeout"))) + + (t ; arguments but no overriding flags, search wiki + (cli::search-for-oneliners arguments + (getopt :long-name "limit") + (getopt :long-name "not-flagged") + (getopt :long-name "all-flagged") + (getopt :long-name "newest"))))) + (uiop:quit)) + + (t ; no arguments and no options, print help + (help))) + (uiop:quit)) + (error (e) + (format *error-output* "~%ERROR: ~a~%" e) + (uiop:quit)) + (#+sbcl sb-sys:interactive-interrupt + #+ccl ccl:interrupt-signal-condition + #+ecl ext:interactive-interrupt + () + (format t "Aborted by User Interrupt.~%") + (uiop:quit)))) diff --git a/app/package.lisp b/app/package.lisp new file mode 100644 index 0000000..7e4c234 --- /dev/null +++ b/app/package.lisp @@ -0,0 +1,5 @@ + +(defpackage #:oneliners.cli.app + (:use #:cl #:net.didierverna.clon) + (:local-nicknames (#:a #:alexandria) + (#:cli #:oneliners.cli))) diff --git a/clpmfile.lock b/clpmfile.lock index e852e8c..76e1373 100644 --- a/clpmfile.lock +++ b/clpmfile.lock @@ -76,7 +76,6 @@ ("oneliners.api-client")) ("oneliners.cli.asd" :version :newest :source :implicit-file :systems ("oneliners.cli")) -("osicat" :version "2022-02-20" :source "quicklisp" :systems ("osicat")) ("proc-parse" :version "2019-08-13" :source "quicklisp" :systems ("proc-parse")) ("quri" :version "2021-06-30" :source "quicklisp" :systems ("quri")) ("smart-buffer" :version "2021-10-21" :source "quicklisp" :systems @@ -109,7 +108,6 @@ ("alexandria" ((:system :name "static-vectors") (:system :name "alexandria")) ((:system :name "quri") (:system :name "alexandria")) ((:system :name "proc-parse") (:system :name "alexandria")) - ((:system :name "osicat") (:system :name "alexandria")) ((:system :name "fast-io") (:system :name "alexandria")) ((:system :name "fast-http") (:system :name "alexandria")) ((:system :name "dexador") (:system :name "alexandria")) @@ -135,8 +133,6 @@ ("cffi" ((:system :name "static-vectors") (:system :name "cffi")) ((:system :name "static-vectors") (:system :name "cffi-grovel")) - ((:system :name "osicat") (:system :name "cffi")) - ((:system :name "osicat") (:system :name "cffi-grovel")) ((:system :name "net.didierverna.clon.termio") (:system :name "cffi")) ((:system :name "cl-readline") (:system :name "cffi")) ((:system :name "cl+ssl") (:system :name "cffi")) @@ -231,8 +227,6 @@ ("oneliners.cli.asd" (t (:asd-file :name "oneliners.cli.asd"))) -("osicat" ((:system :name "oneliners.cli") (:system :name "osicat"))) - ("proc-parse" ((:system :name "jonathan") (:system :name "proc-parse")) ((:system :name "fast-http") (:system :name "proc-parse")) ((:system :name "cl-cookie") (:system :name "proc-parse"))) @@ -251,7 +245,6 @@ ((:system :name "oneliners.cli") (:system :name "trivial-clipboard"))) ("trivial-features" - ((:system :name "osicat") (:system :name "trivial-features")) ((:system :name "dexador") (:system :name "trivial-features")) ((:system :name "cl+ssl") (:system :name "trivial-features")) ((:system :name "cffi") (:system :name "trivial-features")) diff --git a/lib/lib.lisp b/lib/lib.lisp new file mode 100644 index 0000000..f49201a --- /dev/null +++ b/lib/lib.lisp @@ -0,0 +1,451 @@ +;;;; main.lisp -- oneliners.cli entrypoint + +;; Copyright (C) 2022 Colin Okay + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU Affero 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 Affero General Public License for more details. + +;; You should have received a copy of the GNU Affero General Public License +;; along with this program. If not, see . +(in-package :oneliners.cli) + +;;; CONFIG AND RESULTS FILE LOCATIONS + +(defvar *ol-output-timeout* 1) + +(defun run-item (ident args &key force-clip (timeout nil timeout-p)) + (with-oneliner (ol ident) + (let ((*ol-output-timeout* (if timeout-p timeout *ol-output-timeout*))) + (bind-vars-and-run-oneliner ol args force-clip)))) + +(defun bind-vars-and-run-oneliner (ol args &optional force-clip) + (let* ((oneliner (oneliner-oneliner ol)) + (runstyle (oneliner-runstyle ol)) + (pos-args (collect-positional-arguments oneliner)) + (named-args (collect-named-arguments oneliner))) + + (when (or (not (oneliner-isflagged ol)) + (y-or-n-p "This oneliner is flagged. Are you sure you want to run it?")) + ;; substitute positional args + (loop for param in pos-args + for arg in args + do (setf oneliner (str:replace-all param arg oneliner))) + ;; substitute named args + (setf args + (mapcar (lambda (s) (str:split "=" s)) + (nthcdr (length pos-args) args))) + (loop for var in named-args + for bound = (assoc (subseq var 1) args :test #'equal) + when bound + do (setf oneliner + (str:replace-all var (second bound) oneliner))) + + (handle-run-oneliner oneliner (or force-clip (equalp runstyle "manual")))))) + +(defun handle-run-oneliner (ol &optional clip) + (if clip + (progn (trivial-clipboard:text ol) + (format t "Copied oneliner to clipboard~%")) + (progn + (ensure-config) + (format t "Attempting to run:~%") + (princ ol) + (princ #\newline) + (princ #\newline) + (run-with-shell ol :shell-name (or (get-shell) "bash"))))) + + +(defun make-fresh-config () + (format t "No configuration file has been found. Running Setup~%~%") + (setf *config* + (make-config + :host (prompt "Oneliner Instance Host: " + :prefill "https://api.oneliners.wiki") + :shell (prompt "With which shell should commands be run: " + :prefill "bash"))) + (write-config-to-disk) + (format t "Configuration has been written to ~a~%. Edit this at any time.~%~%" + (config-file))) + +(defun fetch-config-from-disk () + (let ((conf + (uiop:with-safe-io-syntax () + (uiop:read-file-form (config-file))))) + (assert (valid-config-p conf) () "Invalid configuration file") + (setf *config* conf))) + +(defun ensure-config () + (unless (uiop:file-exists-p (config-file)) + (make-fresh-config)) + (fetch-config-from-disk)) + + +;;; UTILITIES + + +;; (defun cached-result (n) +;; (when (uiop:file-exists-p (cached-oneliners-file)) +;; (let ((contents (with-open-file (input (cached-oneliners-file)) (read input)))) +;; (etypecase n +;; (integer +;; (find n contents :key (lambda (x) (getf x :id)))) +;; (string +;; (find n contents :key (lambda (x) (getf x :name)) :test #'equal)))))) + + +(defmacro with-oneliner ((var name-or-id) &body body) + (assert (symbolp var)) + (let ((nvar (gensym))) + `(let ((,nvar ,name-or-id)) + (a:if-let (,var (the-oneliner ,nvar)) + (progn ,@body) + (format t "Could not find the oneliner specified by ~a~%" ,nvar))))) + + + + + +;;; API REQUEST FUNCTIONS + +(defun the-oneliner (name-or-id) + "Get the oneliner with name-or-id. Try to fetch from local cache, +and, failing that, try to fetch from configured server." + (a:if-let ((ol (cached-result name-or-id))) + ol + (progn + (ensure-config) + (a:when-let (ol + (api:request-with (:host (host)) + (jonathan:parse + (api:get--oneliner-entry name-or-id)))) + (merge-into-cache (list ol)) + ol)))) + +(defun flag-item (ident) + (with-oneliner (ol ident) + (ensure-config) + (api:request-with + (:host (host)) + (api:put--oneliner-entry-flag (getf ol :id) :token (api-token) :value "true")))) + +(defun unflag-item (item-number) + (with-oneliner (ol item-number) + (ensure-config) + (api:request-with + (:host (host)) + (api:put--oneliner-entry-flag (getf ol :id) :token (api-token) :value "false")))) + +(defun lock-item (item-number) + (with-oneliner (ol item-number) + (ensure-config) + (api:request-with + (:host (host)) + (api:put--oneliner-oneliner-locked (getf ol :id) :token (api-token) :value "true")))) + +(defun unlock-item (item-number) + (with-oneliner (ol item-number) + (ensure-config) + (api:request-with + (:host (host)) + (api:put--oneliner-oneliner-locked (getf ol :id) :token (api-token) :value "false")))) + + + +;;; PRINTING ONELINERS + + +(defun print-item-explanation (name-or-number) + (with-oneliner (ol name-or-number) + (set-term-width) + (print-oneliner-result-for-user ol) + (a:when-let (explanation (getf ol :explanation)) + (format t "EXPLANATION:~%~%") + (princ + (string-trim + '(#\newline #\space #\tab) + (if (str:starts-with? (getf ol :oneliner) explanation) + (subseq explanation (length (getf ol :oneliner))) + explanation))) + (terpri)))) + + +(defun add-new-oneliner () + (ensure-config) + (assert (api-token) () "Cannot add a oneliner without an api token.") + (let* ((oneliner + (prompt "Oneliner: " + :expect 'valid-oneliner-string-p + :retry-text "Oneliners must contain at least one command: ")) + (name + (string-trim + '(#\space #\newline #\tab #\linefeed) + (prompt "Name (leave blank for none): " + :expect 'valid-oneliner-name-p + :retry-text "Must begin with a letter contain only letters, numbers, - and _."))) + (init-tags + (tags-from-oneliner oneliner)) + (brief + (prompt "Brief Description: " + :expect 'valid-brief-description-p + :retry-text "Too long. Must be <= 72 characters: ")) + (tags + (progn + (format t "Tags include: ~{~a ~}~%" init-tags) + (append init-tags + (ppcre:split " +" + (prompt "More tags here, or Enter to skip: "))))) + (runstyle + (string-upcase + (prompt "Runstyle (auto or manual): " + :expect 'valid-runstyle-p + :retry-text "Must be (auto or manual): " + :prefill "auto"))) + (explanation + (when (y-or-n-p "Provide an explanation?") + (string-from-editor + (format nil "~a~%~%" oneliner))))) + (api:request-with + (:host (host) + :body (jonathan:to-json + (list :oneliner oneliner + :name (if (plusp (length name)) name :null) + :tags tags + :brief brief + :explanation explanation + :runstyle runstyle)) + :content-type "application/json") + (api:post--oneliner :token (api-token)) + (format t "Added~%")))) + +(defun edit-item (ident) + (with-oneliner (ol ident) + (ensure-config) + (assert (api-token) () "Cannot edit a oneliner without an api token.") + (let* ((oneliner + (prompt "Oneliner: " + :expect 'valid-oneliner-string-p + :retry-text "Oneliners must contain at least one command: " + :prefill (getf ol :oneliner))) + (name + (string-trim + '(#\space #\newline #\tab #\linefeed) + (prompt "Name (leave blank for none): " + :expect 'valid-oneliner-name-p + :retry-text "Must begin with a letter contain only letters, numbers, - and _." + :prefill (if (getf ol :name) (getf ol :name) "")))) + (brief + (prompt "Brief Description: " + :expect 'valid-brief-description-p + :retry-text "Too long. Must be <= 72 characters: " + :prefill (getf ol :brief))) + (init-tags + (tags-from-oneliner oneliner)) + (tags + (progn + (format t "Tags include: ~{~a ~}~%" init-tags) + (append init-tags + (ppcre:split " +" + (prompt "More tags here, or Enter to skip: " + :prefill (str:join " " + (set-difference + (getf ol :tags) + init-tags + :test 'equal))))))) + (runstyle + (string-upcase + (prompt "Runstyle (auto or manual): " + :expect 'valid-runstyle-p + :retry-text "Must be (auto or manual): " + :prefill (getf ol :runstyle)))) + (explanation + (when (y-or-n-p "Provide an explanation?") + (string-from-editor (getf ol :explanation))))) + (let ((new-item + (list :oneliner oneliner + :tags tags + :brief brief + :name (if (plusp (length name)) name :null) + :explanation explanation + :runstyle runstyle))) + (api:request-with + (:host (host) + :body (jonathan:to-json + new-item) + :content-type "application/json") + (api:patch--oneliner-entry-edit (getf ol :id) :token (api-token)) + (update-cached-item new-item) + (format t "OK~%")))))) + +(defun request-invite-code () + (ensure-config) + (api:request-with + (:host (host)) + (let ((invite (jonathan:parse (api:post--invite :token (api-token))))) + (format t "Invite Code: ~a~%Expires: ~a~%" + (getf invite :code) + (getf invite :expires))))) + +(defun login (user pass) + (ensure-config) + (a:when-let (response (jonathan:parse + (api:request-with + (:host (host) + :body (jonathan:to-json (list :password pass :handle user)) + :content-type "application/json") + (api:post--access)))) + (setf (api-token) (getf response :token) + (contributor-handle) user) + (write-config-to-disk) + (format t "Access token written to ~a~%You may now make contributions to the wiki!.~%" + (config-file)))) + +(defun change-pw (current new repeated) + (unless (equal new repeated) + (error "The new password doesn't match the repeated value. Double check.")) + (ensure-config) + (api:request-with + (:host (host)) + (api:put--contributor-who-password (contributor-handle) + :token (api-token) + :value new + :repeated new + :current current))) + +(defparameter +agree-to-the-unlicense+ + "By creating this contributor account, I agree that my contributions + be released into the public domain, for the benefit of the public at + large, and to the detriment of my heirs and successors. I intend + this dedication to be an overt act of relinquishment in perpetuity + of all present and future rights to my contributions under software + copyright law copyright law. More specifically, I agree to release all of my + contributions using The Unlicense. (see https://unlicense.org/)") + + +(defun prompt-for-signature () + (if (y-or-n-p "Provide a contributor signature about yourself? ") + (prompt "Go ahead: ") + "")) + +(defun change-signature () + (let ((new-sig + (prompt-for-signature))) + (ensure-config) + (api:request-with + (:host (host) + :body (jonathan:to-json (list :signature new-sig)) + :content-type "application/json") + (api:put--contributor-who-signature (contributor-handle) :token (api-token)) + (format t "Your signature was changed.~%")))) + +(defun print-contributor (contributor) + (format t "~20a ~@[-- ~a~]~%" + (getf contributor :handle) + (getf contributor :signature))) + +(defun show-contributor (name) + (ensure-config) + (api:request-with + (:host (host)) + (a:when-let (contributor + (api:get--contributor-who name)) + (print-contributor (jonathan:parse contributor))))) + +(defun redeem-invite (token name pass) + (ensure-config ) + (when (yes-or-no-p +agree-to-the-unlicense+) + (api:request-with + (:host (host) + :body (jonathan:to-json (list :handle name + :password1 pass :password2 pass + :signature (prompt-for-signature))) + :content-type "application/json") + (api:post--invite-redeem-code token) + (format t "Account made for ~a. You may log in now~%" name)))) + +;;TODO: check this .. shouldnt access be a username??? +(defun revoke-access () + (ensure-config) + (api:request-with + (:host (host)) + (api:delete--access-access (api-token) :token (api-token)) + (format t "You were logged out~%"))) + +(defun update-cached-item (item) + (merge-into-cache (list item))) + +(defun print-oneliner-result-for-user (oneliner) + (unless *term-width* (set-term-width)) ; setting here as a fallback, can set it elswere if desired. + (let* ((title-line-format-str + (concatenate 'string "~" (prin1-to-string *term-width*) "<[~a]~;~a~;~a~>~%")) + (tags-line-format-string + (concatenate 'string "~" (prin1-to-string *term-width*) "<~a~;by ~a~>~%"))) + (loop repeat *term-width* do (princ #\_)) + (terpri) + (format t title-line-format-str + (getf oneliner :id) + (or (getf oneliner :name) " ") + (format nil "~:[ ~;⚠~]~:[ ~;🔒~]~:[ ~;📋~]" + (getf oneliner :isflagged) + (getf oneliner :islocked) + (equalp "manual" (getf oneliner :runstyle)))) + (format t tags-line-format-string + (format nil "tags: ~{~a~^ ~}" + (getf oneliner :tags)) + (getf oneliner :createdby)) + (loop + with brief = (getf oneliner :brief) + for x from 0 to (length brief) by *term-width* + do (format t "~a~%" + (string-trim '(#\space) + (alexandria-2:subseq* brief x (+ x *term-width*))))) + (format t "~%~a~%~%" (getf oneliner :oneliner)))) + +(defun cache-and-print-search-response (response) + (merge-into-cache + (loop for oneliner in (getf (jonathan:parse response) :oneliners) + collect oneliner + do (print-oneliner-result-for-user oneliner)))) + +(defun newest-oneliners (&optional limit) + (ensure-config) + (api:request-with + (:host (host)) + (let ((response + (if limit + (api:get--oneliners-newest :limit limit) + (api:get--oneliners-newest)))) + (cache-and-print-search-response response)))) + +(defun all-flagged-oneliners (&optional limit) + (ensure-config) + (api:request-with + (:host (host)) + (let ((response + (if limit + (api:get--oneliners-all-flagged :limit limit) + (api:get--oneliners-all-flagged)))) + (cache-and-print-search-response response)))) + +(defun search-for-oneliners (terms limit not-flagged-p all-flagged-p newestp) + (assert (loop for term in terms never (find #\, term) )) + (set-term-width) + (ensure-config) + (let ((response + (api:request-with + (:host (host)) + (api:get--oneliners :tags (str:join "," terms) + :limit limit + :notflagged (if not-flagged-p "true" "false") + :newest (if newestp "true" "false") + :onlyflagged (if all-flagged-p "true" "false"))))) + (cache-and-print-search-response response))) + +;;; RUNNING THINGS IN THE SHELL. + diff --git a/lib/oneliner.lisp b/lib/oneliner.lisp new file mode 100644 index 0000000..b7b404b --- /dev/null +++ b/lib/oneliner.lisp @@ -0,0 +1,59 @@ +;;;; oneliner.lisp -- holds a local representation of onelienrs. + +(in-package :oneliners.cli) + +(defstruct oneliner + id + name + oneliner + tags + brief + explanation + runstyle + createdat + editedat + createdby + isflagged + islocked) + + +(defun collect-positional-arguments (ol) + "Collects the names of all positional arguments in the oneliner, prefix included." + (remove-duplicates + (sort + (ppcre:all-matches-as-strings "#[1-9][0-9]*" (oneliner-oneliner ol)) + #'string<) + :test #'equal)) + +(defun collect-named-arguments (ol) + "Collects the names of all named arguments in the oneliner, prefix included" + (remove-duplicates + (ppcre:all-matches-as-strings "#[A-Za-z][A-Za-z0-9_]*" (oneliner-oneliner ol)) + :test #'equal)) + +(defun tags-from-oneliner (string) + "Splits a string using consequitive whitespace as a separator, +returning a set of tags" + (remove-duplicates + (remove-if-not #'executable-on-system-p (ppcre:split " +" string)) + :test #'equal)) + + + + +;;; VALIDATION OF ONELINER SLOT VALUES + +(defun valid-oneliner-string-p (string) + (and (not (find #\newline string)) + (tags-from-oneliner string))) + +(defun valid-brief-description-p (string) + (<= (length string) 72)) + +(defun valid-runstyle-p (string) + (member string '("auto" "manual") :test 'equalp)) + +(defun valid-oneliner-name-p (string) + (or (equal string "") + (and (< 2 (length string)) + (ppcre:scan "^[a-zA-Z][a-zA-Z0-9_\-]+$" string)))) diff --git a/lib/package.lisp b/lib/package.lisp new file mode 100644 index 0000000..dd336dc --- /dev/null +++ b/lib/package.lisp @@ -0,0 +1,20 @@ + + +(defpackage #:oneliners.cli.running + (:use #:cl) + (:export #:run-with-shell)) + +(defpackage #:oneliners.cli.term + (:use #:cl) + (:export #:*term-width*)) + +(defpackage #:oneliners.cli.prompt + (:use #:cl) + (:local-nicknames (#:rl #:cl-readline)) + (:export #:prompt)) + +(defpackage #:oneliners.cli + (:use :cl) + (:import-from #:oneliners.cli.prompt #:prompt) + (:local-nicknames (#:api #:oneliners.api-client) + (#:a #:alexandria))) diff --git a/lib/prompt.lisp b/lib/prompt.lisp new file mode 100644 index 0000000..6c847f1 --- /dev/null +++ b/lib/prompt.lisp @@ -0,0 +1,30 @@ +;;;; prompt.lisp -- a function using readlline to collect text from the user + + + +(in-package :oneliners.cli.prompt) + +(defun prompt (prompt + &key + (expect (constantly t)) + retry-text + (prefill "")) + ;; register a prefill hook + (rl:register-hook + :pre-input + (lambda () + (rl:insert-text prefill) + (rl:redisplay))) + (unwind-protect + (loop + with prompt-text = prompt + with should-retry-p = t + while should-retry-p + for line = (rl:readline :prompt prompt-text) + when (funcall expect line) + do (setf should-retry-p nil) + when retry-text + do (setf prompt-text retry-text) + finally (return line)) + ;; unregisters the hook. + (rl:register-hook :pre-input nil))) diff --git a/lib/running.lisp b/lib/running.lisp new file mode 100644 index 0000000..5f417e4 --- /dev/null +++ b/lib/running.lisp @@ -0,0 +1,47 @@ +;;;; running.lisp -- functions for running oneliners + + + + +(in-package :oneliners.cli.running) + +(defmacro wait-until ((&key (timeout 1) (poll-every 0.01)) &body check) + "Run CHECK every POLL-EVERY seconds until either TIMEOUT seconds +have passed or CHECK returns non-nil." + (let ((clockvar (gensym)) + (var (gensym))) + `(loop + for ,clockvar from 0 by ,poll-every to ,timeout + for ,var = (progn ,@check) + when ,var + return ,var + do (sleep ,poll-every) + finally (return nil)))) + +(defun run-with-shell + (command + &key + shell-name + await-output-p + (output-stream *standard-output*)) + "run COMMAND, a string, in a fresh shell environment, initialized +with SHELL-NAME. The output from the command read line by line and is +printed to OUTPUT-STREAM. " + (let ((shell + (uiop:launch-program shell-name :input :stream :output :stream))) + (symbol-macrolet ((shell-input (uiop:process-info-input shell)) + (shell-output (uiop:process-info-output shell))) + (write-line command shell-input) + (finish-output shell-input) + (if (and await-output-p + (plusp await-output-p) + (wait-until (:timeout await-output-p :poll-every 0.005) + (listen shell-output))) + (loop while (listen shell-output) + do (princ (read-line shell-output) output-stream) + (terpri output-stream) + (sleep 0.005)))))) + + + + diff --git a/lib/state.lisp b/lib/state.lisp new file mode 100644 index 0000000..b98f5ba --- /dev/null +++ b/lib/state.lisp @@ -0,0 +1,62 @@ +;;;; state.lisp -- functions for dealing with client state + +(in-package :oneliners.cli) + +;;; Config Struct + +(defstruct config + handle + api-token + host + shell) + +(defvar *config* nil + "Holds a config struct instance.") + +(defvar *cache* nil + "Holds cached oneliners as a list.") + +;;; GETTING AND SETTING STATE, DYNAMICALLY BOUND + +(defun merge-oneliners (new) + "Modifies *CACHE*. Merge updated oneliners into the *cache*, ensuring to remove old versions." + (setf *cache* + (nconc + new + (delete-if + (lambda (old-oneliner) + (find (oneliner-id old-oneliner) + new + :key #'oneliner-id + :test #'equal)) + *cache*)))) + +(defun get-cached (id-or-name) + "Looks up a oneliner instance by ID-OR-NAME using the current binding of *cache*. " + (find id-or-name + *cache* + :key (etypecase id-or-name + (integer #'oneliner-id) + (string #'oneliner-name)) + :test #'equal)) + +;;; LOADING AND SAVING STATE + +(defun config-file () + "Returns the pahtname holding the location of the config file." + (merge-pathnames ".config/oneliners.config" (user-homedir-pathname))) + +(defun cached-oneliners-file () + "Returns the pathname holding the location of the cache." + (merge-pathnames ".cache/oneliners.cache" (user-homedir-pathname))) + +(defun wipe-cache () + "Deletes the cache, if present." + (uiop:delete-file-if-exists (cached-oneliners-file))) + +(defun write-config-to-disk () + (print-to-file *config* (config-file))) + +(defun write-cache-to-disk () + (print-to-file *cache* (cached-oneliners-file))) + diff --git a/lib/term.lisp b/lib/term.lisp new file mode 100644 index 0000000..c5b472a --- /dev/null +++ b/lib/term.lisp @@ -0,0 +1,15 @@ +;;;; term.lisp -- functions for dealing with the terminal + + + +(in-package :oneliners.cli.term) + +(defvar *term-width* nil) + +(defun set-term-width () + ;; tput cols b/c getenv COLUMNS wasnt working on some terminals + (setf *term-width* + (- + (or (parse-integer (uiop:run-program '("tput" "cols") :output :string) :junk-allowed t) + 80) + 4))) diff --git a/lib/util.lisp b/lib/util.lisp new file mode 100644 index 0000000..290d541 --- /dev/null +++ b/lib/util.lisp @@ -0,0 +1,37 @@ +;;;; util.lisp + +(in-package :oneliners.cli) + +(defun make-temp-file-name () + "Simply makes a file name for a temp file. Uses +UIOP:TEMPORARY-DIRECTORY for the directory." + (namestring + (merge-pathnames (format nil "~a~a" (gensym "oneliners") (get-universal-time)) + (uiop:temporary-directory)))) + + +(defun string-from-editor (&optional contents) + (let ((filename (make-temp-file-name))) + (when contents (a:write-string-into-file contents filename :if-exists :supersede)) + (unwind-protect + (magic-ed:magic-ed filename :eval nil :output :string) + (uiop:delete-file-if-exists filename)))) + + +(defun executable-on-system-p (name) + "A hack that heuristically determines whether or not an executable +with the provided name is on the system. It is not perfect. It +consults the environment PATH, and looks for the command in any of +the directories that appear in the value of that variable." + #+unix + (loop for path in (str:split ":" (uiop:getenv "PATH")) + for directory = (cons :absolute + (cdr (str:split "/" path))) + thereis (uiop:file-exists-p + (make-pathname :name name :directory directory)))) + +(defun print-to-file (printable-object pathname &optional (if-exists :supersede)) + "Prints an object to a file, ensuring that the containing directory exists first." + (ensure-directories-exist pathname) + (with-open-file (out pathname :direction :output :if-exists if-exists) + (print printable-object out))) diff --git a/oneliners.cli.asd b/oneliners.cli.asd index eee30ba..5b0f2e3 100644 --- a/oneliners.cli.asd +++ b/oneliners.cli.asd @@ -6,15 +6,18 @@ "str" "jonathan" "dexador" - "osicat" "net.didierverna.clon" "cl-readline" - "magic-ed" + "magic-ed" "oneliners.api-client") - :components ((:module "src" + :components ((:module "lib" :components - ((:file "prompt") - (:file "lib") + ((:file "package") + (:file "prompt") + (:file "cli"))) + (:module "app" + :components + ((:file "package") (:file "app")))) :description "") diff --git a/src/app.lisp b/src/app.lisp deleted file mode 100644 index c3b4c0a..0000000 --- a/src/app.lisp +++ /dev/null @@ -1,294 +0,0 @@ -;;;; app.lisp -- definition of CLI options and entry point. - -;; Copyright (C) 2022 Colin Okay - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU Affero 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 Affero General Public License for more details. - -;; You should have received a copy of the GNU Affero General Public License -;; along with this program. If not, see . - -(defpackage #:oneliners.cli.app - (:use #:cl #:net.didierverna.clon) - (:local-nicknames (#:a #:alexandria) - (#:cli #:oneliners.cli))) - -(in-package :oneliners.cli.app) - -;;; VERSION -(defparameter +ol-version+ "0.6.0") - -;;; HELP TEXTS -(defparameter +invite-help-text+ - " -New contributor accounts are added to the your oneliners server by -redeeming invite tokens. - -When the --redeem option is passed, the ARGS section is expected to be -three items long, and is interpreted as TOKEN USERNAME PASSWORD. E.g.: - - ol --redeem PHONEYTOKEN c00lhacker my1337pw - -Would attempt to make a new user named c00lhacker with password -my1337pw.") - -(defparameter +oneliners-variables-help-text+ -" -Oneliners may contain variables. There are positional variables and -named variables. - -POSITIONAL VARIABLES appear in the oneliner as a # followed by a -number, which must 1 or greater. For example: - - echo Hello #1, Happy #2 - -The #1 and #2 are a positional variables. You might call the above -like - - ol --run 8 Doofus Tuesday - -Assuming that the above oneliner has ID 8, then \"Hello Doofus, - Happy Tuesday\" would print to the console. - -NAMED VARIABLES are similar. They appear in the oneliner as # followed -by a letter in the Roman alphabet, followed by any sequence of Roman -letters, numbers, or the symbol _. For example: - - echo Hello #name you get a #thing - -The #name and #thing are named variables. You might call the above like so: - - ol --run 3 name=Goober thing='sock in the nose' - -Which should print \"Hello Goober you get a sock in the nose\". - -Finally, you can MIX POSITIONAL AND NAMED VARIABLES so long as, when -you run the oneliner, all positional variables appear first. -") - -(defparameter +configure-your-edtior+ - "Adding explainations for oneliners, either with --add or --edit, -will use a default system editor. If you do not like the default -editor you may configure it by the exporting the EDITOR environment -variable to whatever you prefer. - -E.g. in your .bashrc you might put - -export EDITOR=/usr/bin/zile - -") - - -;;; CLON SYNOPSIS DEFINITION - -(defsynopsis (:postfix "[ARGUMENTS ...]") - (group (:header "SEARCH OPTIONS") - (text :contents "By default, ARGUMENTS are interpeted as search terms for oneliners. For example:") - (text :contents "$ ol grep awk # search for oneliners involving both grep and awk") - (text :contents " ") - - (lispobj :long-name "limit" - :argument-type :optional - :argument-name "NUMBER" - :default-value 10 - :description "The maximum number of results to return." - :typespec 'integer) - (flag :long-name "all-flagged" - :description "Request that only flagged oneliners are returned. Without any ARGUMENTS, simply returns all flagged oneliners.") - (flag :long-name "not-flagged" - :description "Request that no flagged oneliners are returned with the search results. Does nothing without ARGUMENTS") - (flag :long-name "newest" - :description "Return newest oneliners that match. Without any ARGUMENTS, simply returns the newest oneliners.")) - (text :contents " ") - (group (:header "EXECUTION OPTIONS") - (text :contents "Several options override the default interpretation of ARGUMENTS.") - (text :contents "Execution options interpret the first argument as the identifier of a oneliner: ") - (text :contents "$ ol [MORE ARGUMENTS...]") - (text :contents " ") - (flag :long-name "run" - :description "Executes a oneliner by NAME or ID. See also help topic 'variables'.") - (flag :long-name "clip" - :description "Like --run, but puts the oneliner into the clipboard.")) - (text :contents " ") - (group (:header "OTHER OPTIONS") - (flag :long-name "show" - :description "View all information for the oneliner given by NAME or ID") - (lispobj :long-name "timeout" - :argument-type :optional - :argument-name "SECONDS" - :default-value 2 - :typespec 'integer - :description "How long to wait for standard output before giving up.")) - (text :contents " ") - (group (:header "HELP OPTIONS") - (flag :long-name "whois" - :description "View information about a contributor. The first argument is a contributor handle.") - (flag :long-name "help" - :description "Print help for a topic. Topics: wiki, account, invites, variables, editor") - (flag :long-name "version" - :description "Print the client's version")) - (group (:header "Advanced Options" :hidden t) - (flag :long-name "clear-cache" - :description "Clears all cached search results from your system.")) - (group (:header "Editor" :hidden t) - (text :contents +configure-your-edtior+)) - (group (:header "Variables" :hidden t) - (text :contents +oneliners-variables-help-text+)) - (group (:header "Wiki" :hidden t) - (text :contents "Options For Managing Oneliners") - (flag :long-name "add" - :description "Intaractively add a oneliner and update the wiki.") - (flag :long-name "edit" - :description "Interactively edit a oneliner and update the wiki.") - (flag :long-name "flag" - :description "Flag a oneliner for review.") - (flag :long-name "unflag" - :description "If you have admin priviliges, unflag a oneliner.") - (flag :long-name "lock" - :description "If you have admin priviliges, lock a oneliner from being edited.") - (flag :long-name "unlock" - :description "If you have admin priviliges, unlock a oneliner.")) - (group (:header "Account" :hidden t) - (text :contents "Options for Managing Your Contributor Account") - (flag :long-name "login" - :description "Attempt to login to your contributor account. ARGS are interpreted as USERNAME PASSWORD.") - (flag :long-name "logout" - :description "Revoke your own access token.") - (flag :long-name "change-password" - :description "Change your password. ARGS are interpreted as CURRENTPW NEWPW NEWPWAGAIN") - (flag :long-name "change-signature" - :description "Change your contributor signature. You will be prompted.")) - (group (:header "Invites" :hidden t) - (text :contents " ") - (text :contents "Options For Making Invites and Redeeming Tokens") - (flag :long-name "invite" - :description "Request an invite token to send to a friend.") - (flag :long-name "redeem" - :description "Redeem an invite token.") - (text :contents +invite-help-text+))) - -;;; HELPERS - -(defun find-group-with-header (header) - "This function should be built in. Is it? How to know? The -documentation is both extensive and trash. Any manual that expects -you to go to sleep with it at night is written for the author more -than the users." - (loop for item in (net.didierverna.clon::items *synopsis*) - when (and (typep item 'net.didierverna.clon::group) - (string-equal header (net.didierverna.clon::header item))) - return item)) - -(defun prepare-oneliner-arguments (arguments) - "Takes a list of arguments, as gathered by (REMAINDER), and returns - a list that looks like (ID-OR-NAME . ARGS) where ID-OR-NAME is - either an integer or a string." - (a:if-let (id (parse-integer (first arguments) :junk-allowed t)) - (cons id (rest arguments)) - arguments)) - -;;; MAIN ENTRY POINT - -(defun main () - "Entry point for our standalone application." - (make-context) - (handler-case - (let ((arguments (remainder))) - (cond - ((getopt :long-name "version") - (format t "Oneliner CLI Version: ~a~%" +ol-version+)) - ((getopt :long-name "help") - (if (and arguments (find-group-with-header (first arguments))) - (help :item (find-group-with-header (first arguments))) - (help)) - (uiop:quit)) - ((getopt :long-name "whois") - (assert (first arguments) () "--whois requires an argument, a user handle.") - (cli::show-contributor (first arguments))) - - ((getopt :long-name "redeem") - (assert (= 3 (length arguments)) () "--redeem requires exatly three arguments.") - (destructuring-bind (token name pass) arguments - (cli::redeem-invite token name pass))) - - ((getopt :long-name "login") - (assert (= 2 (length arguments)) () "--login requires exactly two arguments.") - (destructuring-bind (user pass) arguments - (cli::login user pass))) - - ((getopt :long-name "change-password") - (assert (= 3 (length arguments)) () "--change-password requires exactly three arguments." ) - (destructuring-bind (current new repeated) arguments - (cli::change-pw current new repeated))) - - ((getopt :long-name "change-signature") - (cli::change-signature)) - - ((getopt :long-name "invite") - (cli::request-invite-code)) - - ((getopt :long-name "logout") - (cli::revoke-access)) - - ((getopt :long-name "add") - (cli::add-new-oneliner)) - - ((and (null arguments) (getopt :long-name "all-flagged")) - (cli::all-flagged-oneliners (getopt :long-name "limit"))) - - ((and (null arguments) (getopt :long-name "newest")) - (cli::newest-oneliners (getopt :long-name "limit"))) - - ((getopt :long-name "clear-cache") - (cli::wipe-cache)) - - (arguments - (destructuring-bind (id-or-name . args) (prepare-oneliner-arguments arguments) - (cond - ((getopt :long-name "flag") - (cli::flag-item id-or-name )) - ((getopt :long-name "unflag") - (cli::unflag-item id-or-name)) - ((getopt :long-name "lock") - (cli::lock-item id-or-name )) - ((getopt :long-name "unlock") - (cli::unlock-item id-or-name )) - ((getopt :long-name "edit") - (cli::edit-item id-or-name )) - ((getopt :long-name "show") - (cli::print-item-explanation id-or-name)) - ((getopt :long-name "clip") - (cli::run-item id-or-name args - :force-clip t - :timeout (getopt :long-name "timeout"))) - ((getopt :long-name "run") - (cli::run-item id-or-name args - :timeout (getopt :long-name "timeout"))) - - (t ; arguments but no overriding flags, search wiki - (cli::search-for-oneliners arguments - (getopt :long-name "limit") - (getopt :long-name "not-flagged") - (getopt :long-name "all-flagged") - (getopt :long-name "newest"))))) - (uiop:quit)) - - (t ; no arguments and no options, print help - (help))) - (uiop:quit)) - (error (e) - (format *error-output* "~%ERROR: ~a~%" e) - (uiop:quit)) - (#+sbcl sb-sys:interactive-interrupt - #+ccl ccl:interrupt-signal-condition - #+ecl ext:interactive-interrupt - () - (format t "Aborted by User Interrupt.~%") - (uiop:quit)))) diff --git a/src/lib.lisp b/src/lib.lisp deleted file mode 100644 index 4e1630e..0000000 --- a/src/lib.lisp +++ /dev/null @@ -1,622 +0,0 @@ -;;;; main.lisp -- oneliners.cli entrypoint - -;; Copyright (C) 2022 Colin Okay - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU Affero 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 Affero General Public License for more details. - -;; You should have received a copy of the GNU Affero General Public License -;; along with this program. If not, see . - - -(defpackage #:oneliners.cli - (:use :cl) - (:import-from #:oneliners.cli.prompt #:prompt) - (:local-nicknames (#:api #:oneliners.api-client) - (#:a #:alexandria))) - -(in-package :oneliners.cli) - -;;; CONFIG AND RESULTS FILE LOCATIONS - -(defvar *config* nil - "A configuration plist") - -(defvar *ol-output-timeout* 1) - -(defun ensure-local-state () - (ensure-config) - (setf api::*host* (getf *config* :host))) - - -(defun valid-config-p (config) - (and (listp config) - (evenp (length config)) - (stringp (getf config :host)) - t)) - -(defun write-config-to-disk () - (let ((conf-file (config-file))) - (ensure-directories-exist conf-file) - (with-open-file (out conf-file :direction :output :if-exists :supersede) - (print *config* out)))) - -(defun make-config (&key host api-token editor (shell "bash")) - (append (when host (list :host host)) - (when api-token (list :api-token api-token)) - (list :shell shell))) - -(defun make-fresh-config () - (format t "No configuration file has been found. Running Setup~%~%") - (setf *config* - (make-config - :host (prompt "Oneliner Instance Host: " - :prefill "https://api.oneliners.wiki") - :shell (prompt "With which shell should commands be run: " - :prefill "bash"))) - (write-config-to-disk) - (format t "Configuration has been written to ~a~%. Edit this at any time.~%~%" - (config-file))) - -(defun fetch-config-from-disk () - (let ((conf - (uiop:with-safe-io-syntax () - (uiop:read-file-form (config-file))))) - (assert (valid-config-p conf) () "Invalid configuration file") - (setf *config* conf))) - -(defun ensure-config () - (unless (uiop:file-exists-p (config-file)) - (make-fresh-config)) - (fetch-config-from-disk)) - -(defun host () (getf *config* :host)) -(defun api-token () (getf *config* :api-token)) -(defun (setf api-token) (newval) - (setf (getf *config* :api-token) newval)) -(defun get-shell () - (getf *config* :shell)) -(defun contributor-handle () (getf *config* :handle)) -(defun (setf contributor-handle) (newval) - (setf (getf *config* :handle) newval)) - -(defun config-file () - (merge-pathnames ".config/oneliners.config" (user-homedir-pathname))) - -(defun cached-oneliners-file () - (merge-pathnames ".cache/cached_oneliners" (user-homedir-pathname))) - -(defun wipe-cache () - (uiop:delete-file-if-exists (cached-oneliners-file))) - -(defun merge-into-cache (new-ols) - (let* ((cached - (when (uiop:file-exists-p (cached-oneliners-file)) - (with-open-file (input (cached-oneliners-file)) (read input)))) - (updated - (append - new-ols - (loop for old in cached - for id = (getf old :id) - unless (find id new-ols :key (lambda (x) (getf x :id))) - collect old)))) - (ensure-directories-exist (cached-oneliners-file)) - (with-open-file (output (cached-oneliners-file) :direction :output :if-exists :supersede) - (print updated output)))) - -;;; UTILITIES -(defun make-temp-file-name () - (namestring - (merge-pathnames (format nil "~a" (gensym "oneliners")) (uiop:temporary-directory)))) - -(defun string-from-editor (&optional contents) - (let ((filename (make-temp-file-name))) - (when contents (a:write-string-into-file contents filename :if-exists :supersede)) - (unwind-protect - (magic-ed:magic-ed filename :eval nil :output :string) - (uiop:delete-file-if-exists filename)))) - -(defun executable-on-system-p (name) - "A hack that heuristically determins whether or not an executable -with the provided name is on the system. It is not perfect. It -consults the environment PATH, and looks for the command in any of -the directories that appear in the value of that variable." - #+unix - (loop for path in (str:split ":" (uiop:getenv "PATH")) - for directory = (cons :absolute - (cdr (str:split "/" path))) - thereis (uiop:file-exists-p - (make-pathname :name name :directory directory)))) - -(defun tags-from-oneliner (oneliner) - (remove-duplicates - (remove-if-not #'executable-on-system-p (ppcre:split " +" oneliner)) - :test #'equal)) - - - - - -(defun cached-result (n) - (when (uiop:file-exists-p (cached-oneliners-file)) - (let ((contents (with-open-file (input (cached-oneliners-file)) (read input)))) - (etypecase n - (integer - (find n contents :key (lambda (x) (getf x :id)))) - (string - (find n contents :key (lambda (x) (getf x :name)) :test #'equal)))))) - -(defmacro with-oneliner ((var name-or-id) &body body) - (assert (symbolp var)) - (let ((nvar (gensym))) - `(let ((,nvar ,name-or-id)) - (a:if-let (,var (the-oneliner ,nvar)) - (progn ,@body) - (format t "Could not find the oneliner specified by ~a~%" ,nvar))))) - -(defun print-item-explanation (name-or-number) - (with-oneliner (ol name-or-number) - (set-term-width) - (print-oneliner-result-for-user ol) - (a:when-let (explanation (getf ol :explanation)) - (format t "EXPLANATION:~%~%") - (princ - (string-trim - '(#\newline #\space #\tab) - (if (str:starts-with? (getf ol :oneliner) explanation) - (subseq explanation (length (getf ol :oneliner))) - explanation))) - (terpri)))) - -;;; API REQUEST FUNCTIONS - -(defun the-oneliner (name-or-id) - "Get the oneliner with name-or-id. Try to fetch from local cache, -and, failing that, try to fetch from configured server." - (a:if-let ((ol (cached-result name-or-id))) - ol - (progn - (ensure-config) - (a:when-let (ol - (api:request-with (:host (host)) - (jonathan:parse - (api:get--oneliner-entry name-or-id)))) - (merge-into-cache (list ol)) - ol)))) - -(defun flag-item (ident) - (with-oneliner (ol ident) - (ensure-config) - (api:request-with - (:host (host)) - (api:put--oneliner-entry-flag (getf ol :id) :token (api-token) :value "true")))) - -(defun unflag-item (item-number) - (with-oneliner (ol item-number) - (ensure-config) - (api:request-with - (:host (host)) - (api:put--oneliner-entry-flag (getf ol :id) :token (api-token) :value "false")))) - -(defun lock-item (item-number) - (with-oneliner (ol item-number) - (ensure-config) - (api:request-with - (:host (host)) - (api:put--oneliner-oneliner-locked (getf ol :id) :token (api-token) :value "true")))) - -(defun unlock-item (item-number) - (with-oneliner (ol item-number) - (ensure-config) - (api:request-with - (:host (host)) - (api:put--oneliner-oneliner-locked (getf ol :id) :token (api-token) :value "false")))) - -(defun collect-positional-arguments (oneliner) - (remove-duplicates - (sort - (ppcre:all-matches-as-strings "#[1-9][0-9]*" oneliner) - #'string<) - :test #'equal)) - -(defun collect-named-arguments (oneliner) - (remove-duplicates - (ppcre:all-matches-as-strings "#[A-Za-z][A-Za-z0-9_]*" oneliner) - :test #'equal)) - -(defun handle-run-oneliner (ol &optional clip) - (if clip - (progn (trivial-clipboard:text ol) - (format t "Copied oneliner to clipboard~%")) - (progn - (ensure-config) - (format t "Attempting to run:~%") - (princ ol) - (princ #\newline) - (princ #\newline) - (run-with-shell ol :shell-name (or (get-shell) "bash"))))) - -(defun bind-vars-and-run-oneliner (ol args &optional force-clip) - (let* ((oneliner (getf ol :oneliner)) - (runstyle (getf ol :runstyle)) - (pos-args (collect-positional-arguments oneliner)) - (named-args (collect-named-arguments oneliner))) - - (when (or (not (getf ol :isflagged)) - (y-or-n-p "This oneliner is flagged. Are you sure you want to run it?")) - ;; substitute positional args - (loop for param in pos-args - for arg in args - do (setf oneliner (str:replace-all param arg oneliner))) - ;; substitute named args - (setf args - (mapcar (lambda (s) (str:split "=" s)) - (nthcdr (length pos-args) args))) - (loop for var in named-args - for bound = (assoc (subseq var 1) args :test #'equal) - when bound - do (setf oneliner - (str:replace-all var (second bound) oneliner))) - - (handle-run-oneliner oneliner (or force-clip (equalp runstyle "manual")))))) - -(defun run-item (ident args &key force-clip (timeout nil timeout-p)) - (with-oneliner (ol ident) - (let ((*ol-output-timeout* (if timeout-p timeout *ol-output-timeout*))) - (bind-vars-and-run-oneliner ol args force-clip)))) - -(defun valid-oneliner-string-p (string) - (and (not (find #\newline string)) - (tags-from-oneliner string))) - -(defun valid-brief-description-p (string) - (<= (length string) 72)) - -(defun valid-runstyle-p (string) - (member string '("auto" "manual") :test 'equalp)) - -(defun valid-oneliner-name-p (string) - (or (equal string "") - (and (< 2 (length string)) - (ppcre:scan "^[a-zA-Z][a-zA-Z0-9_\-]+$" string)))) - -(defun add-new-oneliner () - (ensure-config) - (assert (api-token) () "Cannot add a oneliner without an api token.") - (let* ((oneliner - (prompt "Oneliner: " - :expect 'valid-oneliner-string-p - :retry-text "Oneliners must contain at least one command: ")) - (name - (string-trim - '(#\space #\newline #\tab #\linefeed) - (prompt "Name (leave blank for none): " - :expect 'valid-oneliner-name-p - :retry-text "Must begin with a letter contain only letters, numbers, - and _."))) - (init-tags - (tags-from-oneliner oneliner)) - (brief - (prompt "Brief Description: " - :expect 'valid-brief-description-p - :retry-text "Too long. Must be <= 72 characters: ")) - (tags - (progn - (format t "Tags include: ~{~a ~}~%" init-tags) - (append init-tags - (ppcre:split " +" - (prompt "More tags here, or Enter to skip: "))))) - (runstyle - (string-upcase - (prompt "Runstyle (auto or manual): " - :expect 'valid-runstyle-p - :retry-text "Must be (auto or manual): " - :prefill "auto"))) - (explanation - (when (y-or-n-p "Provide an explanation?") - (string-from-editor - (format nil "~a~%~%" oneliner))))) - (api:request-with - (:host (host) - :body (jonathan:to-json - (list :oneliner oneliner - :name (if (plusp (length name)) name :null) - :tags tags - :brief brief - :explanation explanation - :runstyle runstyle)) - :content-type "application/json") - (api:post--oneliner :token (api-token)) - (format t "Added~%")))) - -(defun edit-item (ident) - (with-oneliner (ol ident) - (ensure-config) - (assert (api-token) () "Cannot edit a oneliner without an api token.") - (let* ((oneliner - (prompt "Oneliner: " - :expect 'valid-oneliner-string-p - :retry-text "Oneliners must contain at least one command: " - :prefill (getf ol :oneliner))) - (name - (string-trim - '(#\space #\newline #\tab #\linefeed) - (prompt "Name (leave blank for none): " - :expect 'valid-oneliner-name-p - :retry-text "Must begin with a letter contain only letters, numbers, - and _." - :prefill (if (getf ol :name) (getf ol :name) "")))) - (brief - (prompt "Brief Description: " - :expect 'valid-brief-description-p - :retry-text "Too long. Must be <= 72 characters: " - :prefill (getf ol :brief))) - (init-tags - (tags-from-oneliner oneliner)) - (tags - (progn - (format t "Tags include: ~{~a ~}~%" init-tags) - (append init-tags - (ppcre:split " +" - (prompt "More tags here, or Enter to skip: " - :prefill (str:join " " - (set-difference - (getf ol :tags) - init-tags - :test 'equal))))))) - (runstyle - (string-upcase - (prompt "Runstyle (auto or manual): " - :expect 'valid-runstyle-p - :retry-text "Must be (auto or manual): " - :prefill (getf ol :runstyle)))) - (explanation - (when (y-or-n-p "Provide an explanation?") - (string-from-editor (getf ol :explanation))))) - (let ((new-item - (list :oneliner oneliner - :tags tags - :brief brief - :name (if (plusp (length name)) name :null) - :explanation explanation - :runstyle runstyle))) - (api:request-with - (:host (host) - :body (jonathan:to-json - new-item) - :content-type "application/json") - (api:patch--oneliner-entry-edit (getf ol :id) :token (api-token)) - (update-cached-item new-item) - (format t "OK~%")))))) - -(defun request-invite-code () - (ensure-config) - (api:request-with - (:host (host)) - (let ((invite (jonathan:parse (api:post--invite :token (api-token))))) - (format t "Invite Code: ~a~%Expires: ~a~%" - (getf invite :code) - (getf invite :expires))))) - -(defun login (user pass) - (ensure-config) - (a:when-let (response (jonathan:parse - (api:request-with - (:host (host) - :body (jonathan:to-json (list :password pass :handle user)) - :content-type "application/json") - (api:post--access)))) - (setf (api-token) (getf response :token) - (contributor-handle) user) - (write-config-to-disk) - (format t "Access token written to ~a~%You may now make contributions to the wiki!.~%" - (config-file)))) - -(defun change-pw (current new repeated) - (unless (equal new repeated) - (error "The new password doesn't match the repeated value. Double check.")) - (ensure-config) - (api:request-with - (:host (host)) - (api:put--contributor-who-password (contributor-handle) - :token (api-token) - :value new - :repeated new - :current current))) - -(defparameter +agree-to-the-unlicense+ - "By creating this contributor account, I agree that my contributions - be released into the public domain, for the benefit of the public at - large, and to the detriment of my heirs and successors. I intend - this dedication to be an overt act of relinquishment in perpetuity - of all present and future rights to my contributions under software - copyright law copyright law. More specifically, I agree to release all of my - contributions using The Unlicense. (see https://unlicense.org/)") - - -(defun prompt-for-signature () - (if (y-or-n-p "Provide a contributor signature about yourself? ") - (prompt "Go ahead: ") - "")) - -(defun change-signature () - (let ((new-sig - (prompt-for-signature))) - (ensure-config) - (api:request-with - (:host (host) - :body (jonathan:to-json (list :signature new-sig)) - :content-type "application/json") - (api:put--contributor-who-signature (contributor-handle) :token (api-token)) - (format t "Your signature was changed.~%")))) - -(defun print-contributor (contributor) - (format t "~20a ~@[-- ~a~]~%" - (getf contributor :handle) - (getf contributor :signature))) - -(defun show-contributor (name) - (ensure-config) - (api:request-with - (:host (host)) - (a:when-let (contributor - (api:get--contributor-who name)) - (print-contributor (jonathan:parse contributor))))) - -(defun redeem-invite (token name pass) - (ensure-config ) - (when (yes-or-no-p +agree-to-the-unlicense+) - (api:request-with - (:host (host) - :body (jonathan:to-json (list :handle name - :password1 pass :password2 pass - :signature (prompt-for-signature))) - :content-type "application/json") - (api:post--invite-redeem-code token) - (format t "Account made for ~a. You may log in now~%" name)))) - -;;TODO: check this .. shouldnt access be a username??? -(defun revoke-access () - (ensure-config) - (api:request-with - (:host (host)) - (api:delete--access-access (api-token) :token (api-token)) - (format t "You were logged out~%"))) - -(defun update-cached-item (item) - (merge-into-cache (list item))) - -(defvar *term-width* nil) - -(defun set-term-width () - ;; tput cols b/c getenv COLUMNS wasnt working on some terminals - (setf *term-width* - (- - (or (parse-integer (uiop:run-program '("tput" "cols") :output :string) :junk-allowed t) - 80) - 4))) - -(defun print-oneliner-result-for-user (oneliner) - (unless *term-width* (set-term-width)) ; setting here as a fallback, can set it elswere if desired. - (let* ((title-line-format-str - (concatenate 'string "~" (prin1-to-string *term-width*) "<[~a]~;~a~;~a~>~%")) - (tags-line-format-string - (concatenate 'string "~" (prin1-to-string *term-width*) "<~a~;by ~a~>~%"))) - (loop repeat *term-width* do (princ #\_)) - (terpri) - (format t title-line-format-str - (getf oneliner :id) - (or (getf oneliner :name) " ") - (format nil "~:[ ~;⚠~]~:[ ~;🔒~]~:[ ~;📋~]" - (getf oneliner :isflagged) - (getf oneliner :islocked) - (equalp "manual" (getf oneliner :runstyle)))) - (format t tags-line-format-string - (format nil "tags: ~{~a~^ ~}" - (getf oneliner :tags)) - (getf oneliner :createdby)) - (loop - with brief = (getf oneliner :brief) - for x from 0 to (length brief) by *term-width* - do (format t "~a~%" - (string-trim '(#\space) - (alexandria-2:subseq* brief x (+ x *term-width*))))) - (format t "~%~a~%~%" (getf oneliner :oneliner)))) - -(defun cache-and-print-search-response (response) - (merge-into-cache - (loop for oneliner in (getf (jonathan:parse response) :oneliners) - collect oneliner - do (print-oneliner-result-for-user oneliner)))) - -(defun newest-oneliners (&optional limit) - (ensure-config) - (api:request-with - (:host (host)) - (let ((response - (if limit - (api:get--oneliners-newest :limit limit) - (api:get--oneliners-newest)))) - (cache-and-print-search-response response)))) - -(defun all-flagged-oneliners (&optional limit) - (ensure-config) - (api:request-with - (:host (host)) - (let ((response - (if limit - (api:get--oneliners-all-flagged :limit limit) - (api:get--oneliners-all-flagged)))) - (cache-and-print-search-response response)))) - -(defun search-for-oneliners (terms limit not-flagged-p all-flagged-p newestp) - (assert (loop for term in terms never (find #\, term) )) - (set-term-width) - (ensure-config) - (let ((response - (api:request-with - (:host (host)) - (api:get--oneliners :tags (str:join "," terms) - :limit limit - :notflagged (if not-flagged-p "true" "false") - :newest (if newestp "true" "false") - :onlyflagged (if all-flagged-p "true" "false"))))) - (cache-and-print-search-response response))) - -;;; RUNNING THINGS IN THE SHELL. - -(defun parent-process-name () - "Prints the name of the parent process of the current process." - (let ((ppidfile (format nil "/proc/~a/status" (osicat-posix:getppid)))) - (first (last - (ppcre:split "\\s" - (with-open-file (input ppidfile) - (read-line input))))))) - -(defmacro wait-until ((&key (timeout 1) (poll-every 0.01)) &body check) - "Run CHECK every POLL-EVERY seconds until either TIMEOUT seconds -have passed or CHECK returns non-nil." - (let ((clockvar (gensym)) - (var (gensym))) - `(loop - for ,clockvar from 0 by ,poll-every to ,timeout - for ,var = (progn ,@check) - when ,var - return ,var - do (sleep ,poll-every) - finally (return nil)))) - - - -(defun run-with-shell - (command - &key - (shell-name (parent-process-name)) - (await-output-p *ol-output-timeout*) - (output-stream *standard-output*)) - "run COMMAND, a string, in a fresh shell environment, initialized -with SHELL-NAME. The output from the command read line by line and is -printed to OUTPUT-STREAM. " - (let ((shell - (uiop:launch-program shell-name :input :stream :output :stream))) - (symbol-macrolet ((shell-input (uiop:process-info-input shell)) - (shell-output (uiop:process-info-output shell))) - (write-line command shell-input) - (finish-output shell-input) - (if (and await-output-p - (plusp await-output-p) - (wait-until (:timeout await-output-p :poll-every 0.005) - (listen shell-output))) - (loop while (listen shell-output) - do (princ (read-line shell-output) output-stream) - (terpri output-stream) - (sleep 0.005)))))) - - - - diff --git a/src/prompt.lisp b/src/prompt.lisp deleted file mode 100644 index afe8604..0000000 --- a/src/prompt.lisp +++ /dev/null @@ -1,33 +0,0 @@ -;;;; prompt.lisp -- a function using readlline to collect text from the user - -(defpackage #:oneliners.cli.prompt - (:use #:cl) - (:local-nicknames (#:rl #:cl-readline)) - (:export #:prompt)) - -(in-package :oneliners.cli.prompt) - -(defun prompt (prompt - &key - (expect (constantly t)) - retry-text - (prefill "")) - ;; register a prefill hook - (rl:register-hook - :pre-input - (lambda () - (rl:insert-text prefill) - (rl:redisplay))) - (unwind-protect - (loop - with prompt-text = prompt - with should-retry-p = t - while should-retry-p - for line = (rl:readline :prompt prompt-text) - when (funcall expect line) - do (setf should-retry-p nil) - when retry-text - do (setf prompt-text retry-text) - finally (return line)) - ;; unregisters the hook. - (rl:register-hook :pre-input nil))) -- cgit v1.2.3