From 4d2afc4e3c6cc5ce5be4f0d421da49ca6cead09a Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Fri, 18 Feb 2022 13:55:10 -0600 Subject: logging in, redeeming tokens --- build-app.lisp | 64 ++++++++++++++++++++++++++++++----------------- clpmfile.lock | 30 +++++++++++++++++++--- oneliners.api-client.lisp | 9 +++++-- oneliners.cli.asd | 1 + src/lib.lisp | 51 +++++++++++++++++++++++++++---------- 5 files changed, 114 insertions(+), 41 deletions(-) diff --git a/build-app.lisp b/build-app.lisp index 1b16837..bd51d54 100644 --- a/build-app.lisp +++ b/build-app.lisp @@ -12,8 +12,17 @@ ;;; 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.") ;;; CLON SYNOPSIS DEFINITION @@ -21,9 +30,9 @@ (group (:header "Search") (text :contents "Usage: ol [OPTIONS] [TERMS ...]") (text :contents "Each term may be a command name or some tag like 'server' or 'tunnel'") - (lispobj :long-name "count" + (lispobj :long-name "limit" :argument-type :optional - :argument-name "Count" + :argument-name "NUMBER" :default-value 10 :description "The maximum number of results to return." :typespec 'integer) @@ -50,13 +59,12 @@ (flag :long-name "update-interactive" :description "Interactively edit a oneliner and update the wiki.")) (group (:header "Admin" :hidden t) + (flag :long-name "login" + :description "Attempt to login to your contributor account. ARGS are interpreted as USERNAME PASSWORD. Success will return ab API token, writing it automatically into your config file.") (flag :long-name "invite" :description "Request an invite token to send to a friend.") - (stropt :long-name "redeem" - :argument-type :optional - :default-value "DUMMY-TOKEN" - :argument-name "TOKEN" - :description "Redeem an invite token. See also --help-topic=invites")) + (flag :long-name "redeem" + :description "Redeem an invite token. See also --help-topic=invites")) (group (:header "Invites" :hidden t) (text :contents +invite-help-text+))) @@ -82,25 +90,35 @@ than the users." (when (getopt :long-name "help") (help ) (uiop:quit)) - (a:when-let (topic (getopt :long-name "help-topic")) (help :item (find-group-with-header (symbol-name topic))) (uiop:quit)) - - (let ((arguments (remainder))) - - (unless arguments + (handler-case + (let ((arguments (remainder))) + (cond + ((getopt :long-name "redeem") + (destructuring-bind (token name pass) arguments + (cli::redeem-invite token name pass))) + ((getopt :long-name "login") + (destructuring-bind (user pass) arguments + (cli::login user pass))) + (arguments + ;; when the first argument is a number, try run a oneliner + (a:when-let (hist-number (parse-integer (first arguments) :junk-allowed t)) + (format t "TBD: Going to run command ~a with arguments ~a~%" + hist-number (rest arguments)) + (uiop:quit)) + ;; otherwise search for oneliners + (cli::search-for-oneliners arguments + (getopt :long-name "limit") + (getopt :long-name "not-flagged"))) + (t + (help))) + (uiop:quit)) + (error (e) + (format *error-output* "ERROR: ~a~%" e) (help) - (uiop:quit)) - - (alexandria:when-let (hist-number (parse-integer (first arguments) :junk-allowed t)) - (format t "TBD: Going to run command ~a with arguments ~a~%" - hist-number (rest arguments)) - (uiop:quit)) - - (cli:search-for-oneliners arguments :)) - - (uiop:quit)) + (uiop:quit)))) ;;; DUMP EXECUTABLE diff --git a/clpmfile.lock b/clpmfile.lock index c694db9..15bb931 100644 --- a/clpmfile.lock +++ b/clpmfile.lock @@ -42,6 +42,7 @@ ("chipz" :version "2021-08-07" :source "quicklisp" :systems ("chipz")) ("chunga" :version "2020-04-27" :source "quicklisp" :systems ("chunga")) ("cl+ssl" :version "2021-12-30" :source "quicklisp" :systems ("cl+ssl")) +("cl-annot" :version "2015-06-08" :source "quicklisp" :systems ("cl-annot")) ("cl-base64" :version "2020-10-16" :source "quicklisp" :systems ("cl-base64")) ("cl-change-case" :version "2021-04-11" :source "quicklisp" :systems ("cl-change-case")) @@ -52,6 +53,8 @@ ("cl-ppcre" :version "2019-05-21" :source "quicklisp" :systems ("cl-ppcre" "cl-ppcre-unicode")) ("cl-str" :version "2021-05-31" :source "quicklisp" :systems ("str")) +("cl-syntax" :version "2015-04-07" :source "quicklisp" :systems + ("cl-syntax" "cl-syntax-annot")) ("cl-unicode" :version "2021-02-28" :source "quicklisp" :systems ("cl-unicode")) ("cl-utilities" :version "2010-10-07" :source "quicklisp" :systems ("cl-utilities")) @@ -62,6 +65,7 @@ ("fast-io" :version "2020-09-25" :source "quicklisp" :systems ("fast-io")) ("flexi-streams" :version "2021-08-07" :source "quicklisp" :systems ("flexi-streams")) +("jonathan" :version "2020-09-25" :source "quicklisp" :systems ("jonathan")) ("local-time" :version "2021-01-24" :source "quicklisp" :systems ("local-time")) ("named-readtables" :version "2021-12-09" :source "quicklisp" :systems ("named-readtables")) @@ -88,6 +92,8 @@ ("trivial-gray-streams")) ("trivial-mimes" :version "2020-07-15" :source "quicklisp" :systems ("trivial-mimes")) +("trivial-types" :version "2012-04-07" :source "quicklisp" :systems + ("trivial-types")) ("usocket" :version "2019-12-27" :source "quicklisp" :systems ("usocket")) ("xsubseq" :version "2017-08-30" :source "quicklisp" :systems ("xsubseq")) @@ -105,6 +111,7 @@ ((:system :name "fast-http") (:system :name "alexandria")) ((:system :name "dexador") (:system :name "alexandria")) ((:system :name "cl-cookie") (:system :name "alexandria")) + ((:system :name "cl-annot") (:system :name "alexandria")) ((:system :name "cl+ssl") (:system :name "alexandria")) ((:system :name "cffi-grovel") (:system :name "alexandria")) ((:system :name "cffi") (:system :name "alexandria")) @@ -113,6 +120,7 @@ ("babel" ((:system :name "quri") (:system :name "babel")) ((:system :name "proc-parse") (:system :name "babel")) + ((:system :name "jonathan") (:system :name "babel")) ((:system :name "fast-http") (:system :name "babel")) ((:system :name "dexador") (:system :name "babel")) ((:system :name "cffi") (:system :name "babel"))) @@ -137,6 +145,9 @@ ("cl+ssl" ((:system :name "dexador") (:system :name "cl+ssl"))) +("cl-annot" ((:system :name "jonathan") (:system :name "cl-annot")) + ((:system :name "cl-syntax-annot") (:system :name "cl-annot"))) + ("cl-base64" ((:system :name "dexador") (:system :name "cl-base64"))) ("cl-change-case" ((:system :name "str") (:system :name "cl-change-case"))) @@ -162,6 +173,7 @@ ("cl-ppcre" ((:system :name "str") (:system :name "cl-ppcre")) ((:system :name "str") (:system :name "cl-ppcre-unicode")) + ((:system :name "jonathan") (:system :name "cl-ppcre")) ((:system :name "dexador") (:system :name "cl-ppcre")) ((:system :name "cl-unicode") (:system :name "cl-ppcre")) ((:system :name "cl-ppcre-unicode") (:system :name "cl-ppcre")) @@ -171,6 +183,10 @@ ("cl-str" ((:system :name "oneliners.cli") (:system :name "str"))) +("cl-syntax" ((:system :name "jonathan") (:system :name "cl-syntax")) + ((:system :name "jonathan") (:system :name "cl-syntax-annot")) + ((:system :name "cl-syntax-annot") (:system :name "cl-syntax"))) + ("cl-unicode" ((:system :name "cl-ppcre-unicode") (:system :name "cl-unicode"))) ("cl-utilities" ((:system :name "quri") (:system :name "cl-utilities")) @@ -184,17 +200,21 @@ ("fast-http" ((:system :name "dexador") (:system :name "fast-http"))) -("fast-io" ((:system :name "dexador") (:system :name "fast-io"))) +("fast-io" ((:system :name "jonathan") (:system :name "fast-io")) + ((:system :name "dexador") (:system :name "fast-io"))) ("flexi-streams" ((:system :name "smart-buffer") (:system :name "flexi-streams")) ((:system :name "cl+ssl") (:system :name "flexi-streams"))) +("jonathan" ((:system :name "oneliners.cli") (:system :name "jonathan"))) + ("local-time" ((:system :name "cl-cookie") (:system :name "local-time"))) ("named-readtables" ((:system :name "net.didierverna.clon.setup") - (:system :name "named-readtables"))) + (:system :name "named-readtables")) + ((:system :name "cl-syntax") (:system :name "named-readtables"))) ("oneliners.api-client.asd" ((:system :name "oneliners.cli") (:system :name "oneliners.api-client")) @@ -204,7 +224,8 @@ ("osicat" ((:system :name "oneliners.cli") (:system :name "osicat"))) -("proc-parse" ((:system :name "fast-http") (:system :name "proc-parse")) +("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"))) ("quri" ((:system :name "dexador") (:system :name "quri")) @@ -238,6 +259,9 @@ ("trivial-mimes" ((:system :name "dexador") (:system :name "trivial-mimes"))) +("trivial-types" ((:system :name "jonathan") (:system :name "trivial-types")) + ((:system :name "cl-syntax") (:system :name "trivial-types"))) + ("usocket" ((:system :name "dexador") (:system :name "usocket")) ((:system :name "cl+ssl") (:system :name "usocket"))) diff --git a/oneliners.api-client.lisp b/oneliners.api-client.lisp index 98c156d..8d43eae 100644 --- a/oneliners.api-client.lisp +++ b/oneliners.api-client.lisp @@ -47,7 +47,8 @@ header. COOKIES should be an instance of CL-COOKIE:COOKIE-JAR. Defaults to *COOKIES*. " - (let ((content-type-var (gensym))) + (let ((content-type-var (gensym)) + (http-error-var (gensym))) `(let ((*host* (or ,host *host*)) (*body* (or ,body *body*)) (*headers* (or ,headers *headers*)) @@ -55,7 +56,11 @@ COOKIES should be an instance of CL-COOKIE:COOKIE-JAR. Defaults to (,content-type-var ,content-type)) (when ,content-type-var (push (cons "Content-Type" ,content-type-var) *headers*)) - ,@forms))) + (handler-case (progn ,@forms) + (dex:http-request-failed (,http-error-var) + (format *error-output* "~a -- ~a" + (dex:response-status ,http-error-var) + (dex:response-body ,http-error-var))))))) (DEFUN GET--SEARCH (&KEY TAGS LIMIT NOTFLAGGED) diff --git a/oneliners.cli.asd b/oneliners.cli.asd index 45d5d5b..9b390fd 100644 --- a/oneliners.cli.asd +++ b/oneliners.cli.asd @@ -4,6 +4,7 @@ :license "AGPLv3" :depends-on ("trivial-clipboard" "str" + "jonathan" "dexador" "osicat" "net.didierverna.clon" diff --git a/src/lib.lisp b/src/lib.lisp index 2480dab..720ff85 100644 --- a/src/lib.lisp +++ b/src/lib.lisp @@ -2,7 +2,8 @@ (defpackage oneliners.cli (:use :cl) - (:local-nicknames (#:api #:oneliners.api-client))) + (:local-nicknames (#:api #:oneliners.api-client) + (#:a #:alexandria))) (in-package :oneliners.cli) @@ -25,7 +26,13 @@ (let ((conf-file (config-file))) (ensure-directories-exist conf-file) (with-open-file (out conf-file :direction :output) - (print (make-config :host "https://oneliners.wiki") out)))) + (print (make-config :host "http://localhost:8888") out)))) + +(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 fetch-config-from-disk () (let ((conf @@ -41,6 +48,9 @@ (defun host () (getf *config* :host)) (defun api-token () (getf *config* :api-token)) +(defun (setf api-token) (newval) + (setf (getf *config* :api-token) newval)) + (defun config-file () (merge-pathnames ".config/oneliners.config" (user-homedir-pathname))) @@ -53,20 +63,35 @@ (when (uiop:file-exists-p (last-search-file)) (nth n (uiop:read-file-form (last-search-file))))) -;;; SEARCHNG THE WIKI +;;; API REQUEST FUNCTIONS + +(defun login (user pass) + (ensure-config) + (a:when-let (response (jonathan:parse + (api:request-with + (:host (host)) + (api:post--token-contributor user :password pass)))) + (setf (api-token) (getf response :token)) + (write-config-to-disk) + (format t "Access token written to ~a~%" (config-file)))) + +(defun redeem-invite (token name pass) + (ensure-config ) + (api:request-with + (:host (host)) + (api:post--redeem-invite token + :username name + :password1 pass + :password2 pass))) (defun search-for-oneliners (terms limit not-flagged-p) (assert (loop for term in terms never (find #\, term) )) - (handler-case - (api:request-with - (:host (host)) - (api:get--search :tags (str:join ",") - :limit limit - :notflagged (if not-flagged-p "true" "false"))) - (dex:http-request-failed (e) - (format *error-output* "~a -- ~a" - (dex:response-status e) - (dex:response-body e))))) + (ensure-config) + (print (api:request-with + (:host (host)) + (api:get--search :tags (str:join "," terms) + :limit limit + :notflagged (if not-flagged-p "true" "false"))))) ;;; RUNNING COMMANDS -- cgit v1.2.3