Adding oca.el manual token retrieval fallback

oracle/oca.el

@@ -59,6 +59,12 @@
 (defvar oca-access-expires-at nil)
 (defvar oca-refresh-token nil)
 (defvar oca-auth-server-process nil)
+;; Declared to keep byte-compiler aware these URL vars are dynamically bound.
+(defvar url-http-end-of-headers)
+(defvar url-request-method)
+(defvar url-request-extra-headers)
+(defvar url-request-data)
+(defvar url-request-timeout)
 
 (defcustom oca-debug nil
   "When non-nil, emit detailed diagnostics for OCA auth/token flow."
@@ -75,11 +81,131 @@
   :type '(integer)
   :group 'oca)
 
+(defcustom oca-manual-token-page-url
+  "https://apex.oraclecorp.com/pls/apex/r/oca/api-key/home"
+  "URL of the APEX page that displays a manually copyable OCA JWT token."
+  :type '(string)
+  :group 'oca)
+
+(defcustom oca-manual-token-file
+  (expand-file-name "secrets/oca-jwt-token" user-emacs-directory)
+  "File path where a manually pasted OCA JWT token is stored."
+  :type '(file)
+  :group 'oca)
+
+(defcustom oca-manual-token-default-ttl-seconds (* 8 60 60)
+  "Fallback TTL used when a manual OCA JWT token does not provide an `exp' claim."
+  :type '(integer)
+  :group 'oca)
+
+(defvar oca-manual-fallback-in-progress nil)
+
 (defun oca--debug (fmt &rest args)
   "Log OCA debug message using FMT and ARGS when `oca-debug' is non-nil."
   (when oca-debug
     (apply #'message (concat "[oca] " fmt) args)))
 
+(defun oca--base64url-decode-string (s)
+  "Decode base64url string S and return a decoded string."
+  (let* ((standard (replace-regexp-in-string
+                    "_" "/"
+                    (replace-regexp-in-string "-" "+" s)))
+         (pad (mod (- 4 (mod (length standard) 4)) 4)))
+    (base64-decode-string
+     (concat standard (make-string pad ?=)))))
+
+(defun oca--jwt-expiry-epoch (token)
+  "Return JWT `exp' epoch from TOKEN, or nil if it cannot be decoded."
+  (condition-case nil
+      (let* ((parts (split-string token "\\."))
+             (payload (nth 1 parts))
+             (decoded (oca--base64url-decode-string payload))
+             (claims (json-parse-string decoded :object-type 'hash-table))
+             (exp (gethash "exp" claims)))
+        (and (integerp exp) exp))
+    (error nil)))
+
+(defun oca--save-manual-token (token)
+  "Persist manual OCA TOKEN to `oca-manual-token-file' with restricted permissions."
+  (let ((dir (file-name-directory oca-manual-token-file)))
+    (when dir
+      (make-directory dir t)))
+  (with-temp-file oca-manual-token-file
+    (insert token)
+    (insert "\n"))
+  (condition-case nil
+      (set-file-modes oca-manual-token-file #o600)
+    (error nil)))
+
+(defun oca--load-manual-token ()
+  "Return token from `oca-manual-token-file', or nil if unavailable."
+  (when (file-readable-p oca-manual-token-file)
+    (let ((token (string-trim
+                  (with-temp-buffer
+                    (insert-file-contents oca-manual-token-file)
+                    (buffer-string)))))
+      (unless (string-empty-p token) token))))
+
+(defun oca--manual-token-file-fallback-expiry ()
+  "Return fallback expiry epoch for stored manual token file, or nil."
+  (when (file-readable-p oca-manual-token-file)
+    (let* ((attrs (file-attributes oca-manual-token-file))
+           (mtime (file-attribute-modification-time attrs)))
+      (+ (floor (float-time mtime)) oca-manual-token-default-ttl-seconds))))
+
+(defun oca--apply-manual-token (token &optional fallback-expiry)
+  "Set TOKEN as the active OCA token and derive a usable expiry.
+
+When TOKEN has no parseable JWT `exp' claim, use FALLBACK-EXPIRY if provided."
+  (let* ((now (string-to-number (format-time-string "%s")))
+         (exp (or (oca--jwt-expiry-epoch token)
+                  fallback-expiry
+                  (+ now oca-manual-token-default-ttl-seconds))))
+    (setq oca-access-token token
+          oca-token-type "Bearer"
+          oca-refresh-token nil
+          oca-access-expires-at exp)))
+
+(defun oca--prompt-and-save-manual-token ()
+  "Prompt for a manual OCA JWT token, then activate and persist it."
+  (let ((token (string-trim (read-passwd "Paste OCA JWT token: "))))
+    (if (string-empty-p token)
+        (message "No OCA JWT token entered; manual fallback canceled.")
+      (oca--apply-manual-token token)
+      (oca--save-manual-token token)
+      (message "Stored manual OCA JWT token in %s" oca-manual-token-file))))
+
+(defun oca--trigger-manual-fallback ()
+  "Open manual token page and prompt user for JWT token exactly once at a time."
+  (unless oca-manual-fallback-in-progress
+    (setq oca-manual-fallback-in-progress t)
+    (message "OCA token endpoint returned 405; switching to manual token flow.")
+    (run-at-time
+     0 nil
+     (lambda ()
+       (unwind-protect
+           (condition-case err
+               (oca--prompt-and-save-manual-token)
+             (quit (message "Manual OCA token input canceled."))
+             (error (message "Manual OCA token flow failed: %S" err)))
+         (setq oca-manual-fallback-in-progress nil))))
+    (condition-case err
+        (browse-url oca-manual-token-page-url)
+      (error
+       (message "Could not open manual token page (%s): %S"
+                oca-manual-token-page-url err)))))
+
+(defun oca--token-response-body ()
+  "Return current buffer's HTTP response body as a string."
+  (save-excursion
+    (goto-char (point-min))
+    (let ((body-start (or (and (boundp 'url-http-end-of-headers)
+                               url-http-end-of-headers)
+                          (when (re-search-forward "\\r?\\n\\r?\\n" nil t)
+                            (point))
+                          (point-min))))
+      (buffer-substring-no-properties body-start (point-max)))))
+
 (defun oca-make-sso-handler (client_id code_verifier token_url)
   (defun ssohandler (process string)
     (save-match-data
@@ -103,8 +229,12 @@
                 (delete-process oca-auth-server-process))
             (let ((request-start (float-time))
                   (url-request-timeout oca-token-request-timeout-seconds))
-              (oca--debug "token request start timeout=%ss url=%s"
-                          url-request-timeout token_url)
+              (oca--debug
+               "token request start timeout=%ss method=%s url=%s data=%s"
+               url-request-timeout
+               url-request-method
+               token_url
+               url-request-data)
               (url-retrieve
                token_url
                (lambda (status)
@@ -113,30 +243,38 @@
                        (oca--debug "token callback status=%S elapsed=%.3fs"
                                    status (- (float-time) request-start))
                        (goto-char (point-min))
-                       (let ((http-status
-                              (when (re-search-forward "^HTTP/[0-9.]+ \\([0-9]+\\)" nil t)
-                                (string-to-number (match-string 1)))))
+                       (let* ((http-status
+                               (when (re-search-forward "^HTTP/[0-9.]+ \\([0-9]+\\)" nil t)
+                                 (string-to-number (match-string 1))))
+                              (request-error (plist-get status :error)))
                          (oca--debug "token HTTP status=%s" (or http-status "unknown"))
-                         (re-search-forward "^$" nil t)
-                         (delete-region (point) (point-min))
-                         (condition-case err
-                             (let ((result (json-parse-buffer)))
-                               (setq oca-access-token (gethash "access_token" result))
-                               (setq oca-token-type (gethash "token_type" result))
-                               (setq oca-access-expires-at
-                                     (or (gethash "expires_at" result)
-                                         (+ (gethash "expires_in" result)
-                                            (string-to-number (format-time-string "%s")))))
-                               (setq oca-refresh-token (gethash "refresh_token" result))
-                               (if oca-access-token
-                                   (oca--debug "received OCA token")
-                                 (message "OCA token response did not include access_token"))
-                               (oca--debug "token parsed expires-at=%s token-type=%s"
-                                           oca-access-expires-at oca-token-type))
-                           (error
-                            (message "OCA token parse failed: %S" err)
-                            (oca--debug "token parse buffer=%s"
-                                        (buffer-substring-no-properties (point-min) (point-max)))))))
+                         (if (or request-error
+                                 (not (integerp http-status))
+                                 (< http-status 200)
+                                 (>= http-status 300))
+                             (oca--trigger-manual-fallback)
+                           (condition-case err
+                               (let ((result (json-parse-string (oca--token-response-body))))
+                                 (setq oca-access-token (gethash "access_token" result))
+                                 (setq oca-token-type (gethash "token_type" result))
+                                 (setq oca-access-expires-at
+                                       (or (gethash "expires_at" result)
+                                           (+ (gethash "expires_in" result)
+                                              (string-to-number (format-time-string "%s")))))
+                                 (setq oca-refresh-token (gethash "refresh_token" result))
+                                 (if oca-access-token
+                                     (oca--debug "received OCA token")
+                                   (progn
+                                     (message "OCA token response did not include access_token")
+                                     (oca--trigger-manual-fallback)))
+                                 (oca--debug "token parsed expires-at=%s token-type=%s"
+                                             oca-access-expires-at oca-token-type))
+                             (error
+                              (message "OCA token parse failed: %S" err)
+                              (oca--debug
+                               "token parse buffer=%s"
+                               (buffer-substring-no-properties (point-min) (point-max)))
+                              (oca--trigger-manual-fallback))))))
                    (when (buffer-live-p (current-buffer))
                      (kill-buffer (current-buffer))))))))))))
 
@@ -179,25 +317,44 @@
 Waits for at most `oca-auth-timeout-seconds' seconds before raising
 `user-error' to avoid indefinite hangs."
   (interactive)
-  (if (and oca-access-token
+  (let ((now (string-to-number (format-time-string "%s"))))
+    (cond
+     ((and oca-access-token
            oca-access-expires-at
-           (< (string-to-number (format-time-string "%s")) oca-access-expires-at))
-      oca-access-token
-    (let ((start (float-time)))
+           (< now oca-access-expires-at))
+      oca-access-token)
+     (t
       (setq oca-access-token nil)
-      (oca--debug "starting auth flow")
-      (oca-authenticate)
-      (while (and (not oca-access-token)
-                  (< (- (float-time) start) oca-auth-timeout-seconds))
-        (sleep-for 0.2))
-      (if oca-access-token
+      (let ((stored-token (oca--load-manual-token)))
+        (when stored-token
+          (oca--apply-manual-token
+           stored-token
+           (oca--manual-token-file-fallback-expiry))))
+      (if (and oca-access-token
+               oca-access-expires-at
+               (< now oca-access-expires-at))
           (progn
-            (oca--debug "received token after %.3fs" (- (float-time) start))
+            (oca--debug "using stored manual token from %s" oca-manual-token-file)
             oca-access-token)
-        (message "OCA auth timed out after %ss; browser OAuth tab may be unresponsive."
-                 oca-auth-timeout-seconds)
-        (user-error "Timed out waiting for OCA token after %ss (check OAuth browser tab)"
-                    oca-auth-timeout-seconds)))))
+        (let ((start (float-time)))
+          ;; Ensure stale loaded tokens don't short-circuit the wait loop.
+          (setq oca-access-token nil
+                oca-token-type nil
+                oca-refresh-token nil
+                oca-access-expires-at nil)
+          (oca--debug "starting auth flow")
+          (oca-authenticate)
+          (while (and (not oca-access-token)
+                      (< (- (float-time) start) oca-auth-timeout-seconds))
+            (sleep-for 0.2))
+          (if oca-access-token
+              (progn
+                (oca--debug "received token after %.3fs" (- (float-time) start))
+                oca-access-token)
+            (message "OCA auth timed out after %ss; browser OAuth tab may be unresponsive."
+                     oca-auth-timeout-seconds)
+            (user-error "Timed out waiting for OCA token after %ss (check OAuth browser tab)"
+                        oca-auth-timeout-seconds))))))))
 
 ;; (with-eval-after-load 'gptel