;;; ein-gat.el --- hooks to gat -*- lexical-binding: t; -*- ;; Copyright (C) 2019 The Authors ;; Authors: dickmao ;; This file is NOT part of GNU Emacs. ;; ein-gat.el is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; ein-gat.el is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with ein-gat.el. If not, see . ;;; Commentary: ;;; Code: (require 'compile) (require 'seq) (require 'magit-process nil t) (autoload 'ein:jupyter-running-notebook-directory "ein-jupyter") ;; (declare-function magit--process-coding-system "magit-process") ;; (declare-function magit-call-process "magit-process") ;; (declare-function magit-start-process "magit-process") ;; (declare-function magit-process-sentinel "magit-process") (defconst ein:gat-status-cd 7 "gat exits 7 if requiring a change directory.") (defcustom ein:gat-python-command (if (equal system-type 'windows-nt) (or (executable-find "py") (executable-find "pythonw") "python") "python") "Python executable name." :type (append '(choice) (let (result) (dolist (py '("python" "python3" "pythonw" "py") result) (setq result (append result `((const :tag ,py ,py)))))) '((string :tag "Other"))) :group 'ein) (defsubst ein:gat-shell-command (command) (string-trim (shell-command-to-string (concat "2>/dev/null " command)))) (defcustom ein:gat-version (ein:gat-shell-command "gat --project - --region - --zone - version") "Currently, aws or gce." :type 'string :group 'ein) (defconst ein:gat-required-version "0.0.4-pre") (defvar ein:gat-machine-history nil "History of user entered machine type.") (defcustom ein:gat-vendor (ein:gat-shell-command "gat --project - --region - --zone - vendor") "Currently, aws or gce." :type '(choice (const :tag "aws" "aws") (const :tag "gce" "gce")) :group 'ein :set (lambda (symbol value) (setq ein:gat-machine-history nil) (set-default symbol value))) (defcustom ein:gat-gce-zone (ein:gat-shell-command "gcloud config get-value compute/zone") "gcloud project zone." :type 'string :group 'ein) (defcustom ein:gat-gce-region (ein:gat-shell-command "gcloud config get-value compute/region") "gcloud project region." :type 'string :group 'ein) (defcustom ein:gat-aws-region (ein:gat-shell-command "aws configure get region") "gcloud project region." :type 'string :group 'ein) (defcustom ein:gat-gce-project (ein:gat-shell-command "gcloud config get-value core/project") "gcloud project id." :type 'string :group 'ein) (defcustom ein:gat-aws-machine-types (split-string (ein:gat-shell-command "aws ec2 describe-instance-type-offerings --location-type=region --page-size=1000 --filter Name=location,Values=us-east-2 --query 'sort_by(InstanceTypeOfferings, &InstanceType)[].InstanceType' --output text")) "gcloud machine types." :type '(repeat string) :group 'ein) (defcustom ein:gat-gce-machine-types (split-string (ein:gat-shell-command (format "gcloud compute machine-types list --filter=\"zone:%s\" --format=\"value[terminator=' '](name)\"" ein:gat-gce-zone))) "gcloud machine types." :type '(repeat string) :group 'ein) ;; https://accounts.google.com/o/oauth2/auth?client_id=[client-id]&redirect_uri=urn:ietf:wg:oauth:2.0:oob&scope=https://www.googleapis.com/auth/compute&response_type=code ;; curl -d code=[page-code] -d client_id=[client-id] -d client_secret=[client-secret] -d redirect_uri=urn:ietf:wg:oauth:2.0:oob -d grant_type=authorization_code https://accounts.google.com/o/oauth2/token ;; curl -sLk -H "Authorization: Bearer [access-token]" https://compute.googleapis.com/compute/v1/projects/[project-id]/zones/[zone-id]/acceleratorTypes | jq -r -c '.items[].selfLink' (defcustom ein:gat-gpu-types (split-string "nvidia-tesla-t4 nvidia-tesla-v100") "Gat gpu types." :type '(repeat string) :group 'ein) (defcustom ein:gat-base-images '("dickmao/tensorflow-gpu" "dickmao/scipy-gpu" "dickmao/pytorch-gpu") "Known https://hub.docker.com/u/jupyter images." :type '(repeat (string :tag "FROM-appropriate docker image")) :group 'ein) (defvar ein:gat-previous-worktree nil) (defvar ein:gat-urls nil) (defconst ein:gat-master-worktree "master") (defvar ein:gat-current-worktree ein:gat-master-worktree) (defvar ein:gat-disksizegb-history '("default") "History of user entered disk size.") (defvar ein:gat-gpus-history '("0") "History of user entered gpu count.") (defvar ein:gat-gpu-type-history nil "History of user entered gpu types.") (defvar ein:gat-keyname-history nil "History of user entered aws ssh keyname.") (defvar ein:gat-preemptible-history nil "History of preemptible opt-in.") (defun ein:gat-where-am-i (&optional print-message) (interactive "p") (let ((from-end (cl-search "/.gat" default-directory :from-end))) (cond ((and (string= major-mode "magit-process-mode") (string-prefix-p "ein-gat:" (buffer-name))) (aprog1 default-directory (when print-message (message it)))) ((string= major-mode "ein:ipynb-mode") (aprog1 (directory-file-name (file-name-directory (buffer-file-name))) (when print-message (message it)))) ((file-directory-p (concat (file-name-as-directory default-directory) ".gat")) (aprog1 default-directory (when print-message (message it)))) (from-end (aprog1 (file-name-as-directory (cl-subseq default-directory 0 from-end)) (when print-message (message it)))) (t (if-let ((notebook-dir (ein:jupyter-running-notebook-directory)) (notebook (ein:get-notebook)) (where (directory-file-name (concat (file-name-as-directory notebook-dir) (file-name-directory (ein:$notebook-notebook-path notebook)))))) (aprog1 where (when print-message (message it))) (prog1 nil (when print-message (message "nowhere")))))))) (cl-defun ein:gat-jupyter-login (ipynb-name notebook-dir callback &rest args &key public-ip-address) (if public-ip-address (let ((url-or-port (ein:url (format "http://%s:8888" public-ip-address)))) (setf (alist-get (intern url-or-port) ein:gat-urls) notebook-dir) (ein:login url-or-port (lambda (buffer url-or-port) (pop-to-buffer buffer) (ein:notebook-open url-or-port ipynb-name nil callback)))) (ein:log 'error "ein:gat-jupyter-login: no public ip address"))) (defun ein:gat-process-filter (proc string) "Copied `magit-process-filter' with added wrinkle of `ansi-color'. Advising `insert' in `magit-process-filter' is a little sus, and moreover, how would I avoid messing `magit-process-filter' of other processes?" (with-current-buffer (process-buffer proc) (let ((inhibit-read-only t)) (goto-char (process-mark proc)) ;; Find last ^M in string. If one was found, ignore ;; everything before it and delete the current line. (when-let ((ret-pos (cl-position ?\r string :from-end t))) (cl-callf substring string (1+ ret-pos)) (delete-region (line-beginning-position) (point))) (insert (propertize (ansi-color-filter-apply string) 'magit-section (process-get proc 'section))) (set-marker (process-mark proc) (point))))) ;; (defvar magit-process-popup-time) ;; (defvar inhibit-magit-refresh) ;; (defvar magit-process-raise-error) ;; (defvar magit-process-display-mode-line-error) (cl-defun ein:gat-chain (buffer callback exec &rest args &key public-ip-address notebook-dir &allow-other-keys) (declare (indent 0)) (let* ((default-directory (or notebook-dir (ein:gat-where-am-i))) (default-process-coding-system (magit--process-coding-system)) (magit-inhibit-refresh t) (_ (awhen (getenv "GAT_APPLICATION_CREDENTIALS") (push (concat "GOOGLE_APPLICATION_CREDENTIALS=" it) process-environment))) (activate-with-editor-mode (when (string= (car exec) with-editor-emacsclient-executable) (lambda () (when (string= (buffer-name) (car (last exec))) (with-editor-mode 1))))) (process (let ((magit-buffer-name-format "%xein-gat%v: %t%x")) (apply #'magit-start-process exec)))) (when activate-with-editor-mode (add-hook 'find-file-hook activate-with-editor-mode)) ;; (with-current-buffer (process-buffer process) ;; (special-mode)) (with-editor-set-process-filter process #'ein:gat-process-filter) (set-process-sentinel process (lambda (proc event) (let* ((gat-status (process-exit-status proc)) (process-buf (process-buffer proc)) (section (process-get proc 'section)) (gat-status-cd-p (= gat-status ein:gat-status-cd)) worktree-dir new-public-ip-address) (when activate-with-editor-mode (remove-hook 'find-file-hook activate-with-editor-mode)) (let ((magit-process-display-mode-line-error (if gat-status-cd-p nil magit-process-display-mode-line-error)) (magit-process-raise-error (if gat-status-cd-p nil magit-process-raise-error)) (short-circuit (lambda (&rest _args) (when gat-status-cd-p 0)))) (add-function :before-until (symbol-function 'process-exit-status) short-circuit) (unwind-protect (magit-process-sentinel proc event) (remove-function (symbol-function 'process-exit-status) short-circuit))) (cond ((or (zerop gat-status) gat-status-cd-p) (alet (and (bufferp process-buf) (with-current-buffer process-buf (when (integer-or-marker-p (oref section content)) (buffer-substring-no-properties (oref section content) (oref section end))))) (when it (when gat-status-cd-p (setq worktree-dir (when (string-match "^cd\\s-+\\(\\S-+\\)" it) (string-trim (match-string 1 it))))) (when-let ((last-line (car (last (split-string (string-trim it) "\n"))))) (setq new-public-ip-address (when (string-match "^\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" last-line) (string-trim (match-string 1 last-line)))))) (when callback (when (buffer-live-p buffer) (set-buffer buffer)) (let ((magit-process-popup-time 0)) (apply callback (append (when worktree-dir `(:worktree-dir ,worktree-dir)) (when-let ((address (or new-public-ip-address public-ip-address))) `(:public-ip-address ,address)))))))) (t (ein:log 'error "ein:gat-chain: %s exited %s" (car exec) (process-exit-status proc))))))) process)) (defun ein:gat--path (archepath worktree-dir) "Form relative path from ARCHEPATH root, WORKTREE-DIR subroot, ARCHEPATH leaf. With WORKTREE-DIR of 3/4/1/2/.gat/fantab, 1/2/eager.ipynb -> 1/2/.gat/fantab/eager.ipynb 1/2/.gat/fubar/subdir/eager.ipynb -> 1/2/.gat/fantab/subdir/eager.ipynb With WORKTREE-DIR of /home/dick/gat/test-repo2 .gat/getout/eager.ipynb -> eager.ipynb " (when-let ((root (directory-file-name (or (awhen (cl-search ".gat/" archepath :from-end) (cl-subseq archepath 0 it)) (file-name-directory archepath) "")))) (if (zerop (length root)) (concat (replace-regexp-in-string "^\\./" "" (file-name-as-directory (cl-subseq worktree-dir (or (cl-search ".gat/" worktree-dir :from-end) (length worktree-dir))))) (file-name-nondirectory archepath)) (concat (file-name-as-directory (cl-subseq worktree-dir (cl-search root worktree-dir :from-end))) (or (awhen (string-match "\\(\\.gat/[^/]+/\\)" archepath) (cl-subseq archepath (+ it (length (match-string 1 archepath))))) (file-name-nondirectory archepath)))))) (defun ein:gat-zone () (interactive) (cl-case (intern ein:gat-vendor) (gce ein:gat-gce-zone) (otherwise "-"))) (defun ein:gat-region () (interactive) (cl-case (intern ein:gat-vendor) (aws ein:gat-aws-region) (gce ein:gat-gce-region) (otherwise (or ein:gat-aws-region ein:gat-gce-region)))) (defun ein:gat-project () (interactive) (cl-case (intern ein:gat-vendor) (gce ein:gat-gce-project) (otherwise "-"))) (defun ein:gat-machine-types () (interactive) (cl-case (intern ein:gat-vendor) (aws ein:gat-aws-machine-types) (gce ein:gat-gce-machine-types) (otherwise (or ein:gat-aws-machine-types ein:gat-gce-machine-types)))) (defsubst ein:gat-need-upgrade () (version-list-< (version-to-list ein:gat-version) (version-to-list ein:gat-required-version))) (defmacro ein:gat-install-gat (&rest body) `(if (and (executable-find "gat") (not (ein:gat-need-upgrade))) (progn ,@body) (if (zerop (length (ein:gat-region))) (ein:log 'error "ein:gat-install-gat: no cloud utilities detected") (ein:log 'info "ein:gat-install-gat: %s gat..." (if (executable-find "gat") "Upgrading" "Installing")) (let* ((orig-buf (current-buffer)) (bufname "*gat-install*") (dir (make-temp-file "gat-install" t)) (commands `(,(format "cd %s" dir) ,(format "git clone --depth=1 --single-branch --branch=%s https://github.com/dickmao/gat.git" (if noninteractive "dev" ein:gat-required-version)) "make -C gat install")) (compile (format "bash -ex -c '%s'" (mapconcat #'identity commands "; "))) (callback (lambda (_buf msg) (when (cl-search "finished" msg) (with-current-buffer orig-buf (custom-set-default 'ein:gat-version (ein:gat-shell-command "gat --project - --region - --zone - version")) ,@body))))) (let ((compilation-scroll-output t)) (compilation-start compile nil (lambda (&rest _args) bufname))) (with-current-buffer bufname (add-hook 'compilation-finish-functions callback nil t)))))) (defun ein:gat-edit (&optional _refresh) (interactive "P") (ein:gat-install-gat (if-let ((default-directory (ein:gat-where-am-i)) (gat-chain-args `("gat" nil "--project" ,(ein:gat-project) "--region" ,(ein:gat-region) "--zone" ,(ein:gat-zone)))) (if (special-variable-p 'magit-process-popup-time) (let ((magit-process-popup-time -1) (notebook (ein:get-notebook))) (ein:gat-chain (current-buffer) (cl-function (lambda (&rest args &key worktree-dir &allow-other-keys) (if notebook (ein:notebook-open (ein:$notebook-url-or-port notebook) (ein:gat--path (ein:$notebook-notebook-path notebook) worktree-dir) (ein:$notebook-kernelspec notebook)) (cd worktree-dir)))) (append gat-chain-args (list "edit" (alet (ein:gat-elicit-worktree t) (setq ein:gat-previous-worktree ein:gat-current-worktree) (setq ein:gat-current-worktree it)))))) (error "ein:gat-create: magit not installed")) (message "ein:gat-edit: not a notebook buffer")))) ;;;###autoload (defun ein:gat-create (&optional _refresh) (interactive "P") (ein:gat-install-gat (if-let ((default-directory (ein:gat-where-am-i)) (notebook (ein:get-notebook)) (gat-chain-args `("gat" nil "--project" ,(ein:gat-project) "--region" ,(ein:gat-region) "--zone" " -"))) (if (special-variable-p 'magit-process-popup-time) (let ((magit-process-popup-time 0)) (ein:gat-chain (current-buffer) (cl-function (lambda (&rest args &key worktree-dir &allow-other-keys) (ein:notebook-open (ein:$notebook-url-or-port notebook) (ein:gat--path (ein:$notebook-notebook-path notebook) worktree-dir) (ein:$notebook-kernelspec notebook)))) (append gat-chain-args (list "create" (alet (ein:gat-elicit-worktree nil) (setq ein:gat-previous-worktree ein:gat-current-worktree) (setq ein:gat-current-worktree it)))))) (error "ein:gat-create: magit not installed")) (message "ein:gat-create: not a notebook buffer")))) ;;;###autoload (defun ein:gat-run-local-batch (&optional refresh) (interactive "P") (ein:gat--run nil t refresh)) ;;;###autoload (defun ein:gat-run-local (&optional refresh) (interactive "P") (ein:gat--run nil nil refresh)) ;;;###autoload (defun ein:gat-run-remote-batch (&optional refresh) (interactive "P") (ein:gat--run t t refresh)) ;;;###autoload (defun ein:gat-run-remote (&optional refresh) (interactive "P") (ein:gat--run t nil refresh)) (defun ein:gat-hash-password (raw-password) (let ((gat-hash-password-python (format "%s - <= answer 0) finally return answer)) (defun ein:gat-elicit-worktree (extant) (let ((already (split-string (ein:gat-shell-command (format "gat --project %s --region %s --zone %s list" (ein:gat-project) (ein:gat-region) (ein:gat-zone)))))) (if extant (ein:completing-read "Experiment: " already nil t nil nil ein:gat-previous-worktree) (read-string "New experiment: ")))) (defun ein:gat-elicit-disksizegb () "Return nil for default [currently max(8, 6 + image size)]." (interactive) (cl-loop with answer do (setq answer (ein:completing-read (format "Disk GiB%s: " (format " [%s]" (or (car ein:gat-disksizegb-history) "default"))) '("default") nil nil nil 'ein:gat-disksizegb-history (car ein:gat-disksizegb-history))) if (string= answer "default") do (setq answer nil) else do (setq answer (string-to-number answer)) end until (or (null answer) (> answer 0)) finally return answer)) (defun ein:gat-dockerfiles-state () "Return cons of (pre-Dockerfile . post-Dockerfile). Pre-Dockerfile is Dockerfile. if extant, else Dockerfile." (-if-let* ((default-directory (ein:gat-where-am-i)) (notebook-name (cond ((string= major-mode "ein:ipynb-mode") (file-name-nondirectory (buffer-file-name))) (t (aand (ein:get-notebook) (ein:$notebook-notebook-name it))))) (dockers (directory-files (file-name-as-directory default-directory) nil "^Dockerfile"))) (let* ((pre-docker-p (lambda (f) (or (string= f (format "Dockerfile.%s" (file-name-sans-extension notebook-name))) (string= f "Dockerfile")))) (pre-docker (seq-find pre-docker-p (sort (cl-copy-list dockers) #'string>))) (post-docker-p (lambda (f) (string= f (format "%s.gat" pre-docker)))) (post-docker (and (stringp pre-docker) (seq-find post-docker-p (sort (cl-copy-list dockers) #'string>))))) `(,pre-docker . ,post-docker)) '(nil))) (provide 'ein-gat)