diff --git a/src/gemini/package.lisp b/src/gemini/package.lisp index b61a088..a21ee62 100644 --- a/src/gemini/package.lisp +++ b/src/gemini/package.lisp @@ -152,6 +152,7 @@ :header-permanent-failure-p :header-certificate-failure-p :header-certificate-requested-p + :header-input-request-p :header-input-p :header-sensitive-input-p :gemini-protocol-error diff --git a/src/gui/client/gui-goodies.lisp b/src/gui/client/gui-goodies.lisp index 9313b80..46acaa5 100644 --- a/src/gui/client/gui-goodies.lisp +++ b/src/gui/client/gui-goodies.lisp @@ -96,3 +96,24 @@ (with-busy (,root-widget) (with-hourglass ,(list root-widget) ,@body)))) + +(defun password-dialog (parent title message &key (button-message "OK")) + (let ((res nil)) + (gui:with-modal-toplevel (toplevel :title title) + (gui:transient toplevel parent) + (let* ((widget (make-instance 'gui-mw:password-entry + :show-password nil + :master toplevel)) + (label (make-instance 'gui:label + :master toplevel + :text message)) + (ok-button (make-instance 'gui:button + :text button-message + :master toplevel + :command (lambda () + (setf res (gui-mw:secret-string widget)) + (gui:break-mainloop))))) + (gui:grid label 0 0 :sticky :news) + (gui:grid widget 1 0 :sticky :news) + (gui:grid ok-button 1 1 :sticky :news))) + res)) diff --git a/src/gui/client/main-window.lisp b/src/gui/client/main-window.lisp index 29b0843..d03d50e 100644 --- a/src/gui/client/main-window.lisp +++ b/src/gui/client/main-window.lisp @@ -461,6 +461,30 @@ (error (e) (notify-request-error e)))) +(defun get-user-request-query (iri meta main-window &key (sensitive nil)) + (let* ((parsed-iri (iri:iri-parse iri)) + (prompt (format nil + (_ "The server asks:~2%~a") + meta)) + (button-label (_ "Submit")) + (dialog-title (_ "Input query")) + (dialog-function (if sensitive + #'gui-goodies:password-dialog + #'gui-mw:text-input-dialog)) + (raw-input (funcall dialog-function + main-window + dialog-title + prompt + :button-message button-label)) + (encoded-input (maybe-percent-encode raw-input))) + (multiple-value-bind (actual-iri host path query port fragment) + (gemini-client:displace-iri parsed-iri) + (declare (ignore actual-iri query fragment)) + (gemini-parser:make-gemini-iri host + path + :query encoded-input + :port port)))) + (defun start-stream-iri (iri main-window use-cache &optional (status +stream-status-streaming+)) (let ((connecting-response (cev:enqueue-request-and-wait-results :gemini-request 1 @@ -473,7 +497,14 @@ cached original-iri) (displace-gemini-response connecting-response) + (declare (ignore original-iri cached)) (cond + ((gemini-client:header-input-p status-code) + (let ((actual-iri (get-user-request-query iri meta main-window))) + (start-stream-iri actual-iri main-window nil))) + ((gemini-client:header-sensitive-input-p status-code) + (let ((actual-iri (get-user-request-query iri meta main-window :sensitive t))) + (start-stream-iri actual-iri main-window nil))) ((= status-code comm:+tofu-error-status-code+) (when (gui:ask-yesno meta :title (_ "Server certificate error") diff --git a/src/package.lisp b/src/package.lisp index 393e0f0..27016ca 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -3358,7 +3358,8 @@ :with-entry-text-validate :attach-tooltip :attach-tooltips - :with-busy*)) + :with-busy* + :password-dialog)) (defpackage :client-menu-command (:use