1 | ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: cl-user -*- |
---|
2 | ;;;; *********************************************************************** |
---|
3 | ;;;; FILE IDENTIFICATION |
---|
4 | ;;;; |
---|
5 | ;;;; Name: svn-self.lisp |
---|
6 | ;;;; Version: 0.1 |
---|
7 | ;;;; Project: Cocoa IDE |
---|
8 | ;;;; Purpose: Cocoa UI for updating the Cocoa IDE from the source repo |
---|
9 | ;;;; |
---|
10 | ;;;; *********************************************************************** |
---|
11 | |
---|
12 | (in-package :ccl) |
---|
13 | |
---|
14 | ;;; IDE: decide how and whether to handle cvs self-updates. |
---|
15 | ;;; see the cvs/svn code in update-ccl in compile-ccl.lisp |
---|
16 | |
---|
17 | ;;; use GUI::FIND-CCL-DIRECTORY to find the effective CCL directory |
---|
18 | ;;; (it gracefully handles the case where we are running from an |
---|
19 | ;;; app bundle, as well as the case where we are not) |
---|
20 | |
---|
21 | ;;; How to self-update the IDE from the svn or cvs repo |
---|
22 | ;;; 1. Find the ccl directory that corresponds to the running image |
---|
23 | ;;; 2. determine whether this is an svn or cvs checkout |
---|
24 | ;;; 3. SVN: |
---|
25 | ;;; a. find the .svn directory |
---|
26 | ;;; b. run svn info to get the svn URL |
---|
27 | ;;; c. determine from the URL whether we need to authenticate |
---|
28 | ;;; d. get auth tokens if we need them |
---|
29 | ;;; d. record the svn revision before we start (so we can roll back |
---|
30 | ;;; if things go horribly wrong) |
---|
31 | ;;; e. run svn status to check for potential merge conflicts before starting |
---|
32 | ;;; the update |
---|
33 | ;;; f. construct the svn command: |
---|
34 | ;;; i. cd to the proper CCL directory |
---|
35 | ;;; ii. run svn update |
---|
36 | ;;; g. run the svn command with external-process-status. |
---|
37 | ;;; h. check the status of the external command for success or failure: |
---|
38 | ;;; i. if okay, queue a full-rebuild, and a rebuild of the IDE |
---|
39 | ;;; (need to make some infrastructure for queuing these activities |
---|
40 | ;;; and running them on next launch, or immediately in an external process) |
---|
41 | ;;; ii. if not okay, warn the user, and offer to roll back to the |
---|
42 | ;;; previously-recorded version (need to make some infrastructure for |
---|
43 | ;;; running a rollback) |
---|
44 | ;;; TODO: make a cvs version if needed |
---|
45 | |
---|
46 | ;;; VALIDATE-SVN-DATA-PATHNAME p |
---|
47 | ;;; --------------------- |
---|
48 | ;;; returns TRUE if P is really an existing directory that appears to |
---|
49 | ;;; contain valid Subversion metadata; FALSE otherwise |
---|
50 | |
---|
51 | (defun validate-svn-data-pathname (p) |
---|
52 | (and (probe-file p) |
---|
53 | (directoryp p) |
---|
54 | (string= ".svn" (first (last (pathname-directory p)))) |
---|
55 | ;; if we reached this point, it's an existing directory |
---|
56 | ;; named ".svn". now, does it have Subversion metadata files |
---|
57 | ;; in it? |
---|
58 | (let ((subversion-metafiles '("dir-prop-base" "entries" "format" |
---|
59 | "prop-base/" "props/" "text-base/"))) |
---|
60 | (every (lambda (f) (probe-file (merge-pathnames f p))) |
---|
61 | subversion-metafiles)))) |
---|
62 | |
---|
63 | ;;; given a valid-looking .svn directory, we should be able to use |
---|
64 | ;;; the svn executable to get the repository URL. we call: |
---|
65 | ;;; svn info |
---|
66 | ;;; and get a big block of info text. one line of the output |
---|
67 | ;;; is of the form: |
---|
68 | ;;; URL: yatta-yatta |
---|
69 | ;;; where yatta-yatta is the repository URL of the checked out directory |
---|
70 | ;;; Another piece of information we want shows Up here, too: the |
---|
71 | ;;; current revision, on a line of the form: |
---|
72 | ;;; Revision: foobar |
---|
73 | |
---|
74 | (defun split-svn-info-line (line) |
---|
75 | (let* ((split-sequence ": ") |
---|
76 | (split-index (find-matching-subsequence split-sequence line :test #'char=)) |
---|
77 | (prefix (subseq line 0 split-index)) |
---|
78 | (suffix (subseq line (if split-index |
---|
79 | (+ split-index (length split-sequence)) |
---|
80 | (length line))))) |
---|
81 | (list prefix suffix))) |
---|
82 | |
---|
83 | (defun parse-svn-info (info-string) |
---|
84 | (let ((info-lines (split-lines info-string))) |
---|
85 | (mapcar #'split-svn-info-line info-lines))) |
---|
86 | |
---|
87 | (defun get-svn-info (p) |
---|
88 | (parse-svn-info |
---|
89 | (with-output-to-string (out) |
---|
90 | (run-program "svn" `("info" ,(namestring p)) :output out)))) |
---|
91 | |
---|
92 | ;;; we infer from the information in the URL field of the svn info |
---|
93 | ;;; whether we need to authenticate. The assumed criteria in this |
---|
94 | ;;; implementation are that we don't need to authenticate if the |
---|
95 | ;;; URL is an http:: URL; if it's an svn+ssh URL, then we do need |
---|
96 | ;;; to authenticate |
---|
97 | |
---|
98 | (defclass authentication-window-controller (ns:ns-window-controller) |
---|
99 | ((authentication-window :foreign-type :id :reader authentication-window) |
---|
100 | (username-field :foreign-type :id :reader authentication-window-username-field) |
---|
101 | (password-field :foreign-type :id :reader authentication-window-password-field)) |
---|
102 | (:metaclass ns:+ns-object)) |
---|
103 | |
---|
104 | (objc:defmethod #/windowNibName ((self authentication-window-controller)) |
---|
105 | #@"Authenticate") |
---|
106 | |
---|
107 | (objc:defmethod #/authOkay: ((self authentication-window-controller) sender) |
---|
108 | (#/stopModalWithCode: (#/sharedApplication (@class ns-application)) 1) |
---|
109 | (#/orderOut: (authentication-window *authentication-window-controller*) +null-ptr+)) |
---|
110 | |
---|
111 | (objc:defmethod #/authCancel: ((self authentication-window-controller) sender) |
---|
112 | (#/stopModalWithCode: (#/sharedApplication (@class ns-application)) 2) |
---|
113 | (#/orderOut: (authentication-window *authentication-window-controller*) +null-ptr+)) |
---|
114 | |
---|
115 | (defparameter *authentication-window-controller* nil) |
---|
116 | |
---|
117 | (defun get-auth-window () |
---|
118 | (unless *authentication-window-controller* |
---|
119 | (setf *authentication-window-controller* |
---|
120 | (make-instance 'authentication-window-controller)) |
---|
121 | (#/initWithWindowNibName: *authentication-window-controller* #@"Authenticate")) |
---|
122 | (unless (#/isWindowLoaded *authentication-window-controller*) |
---|
123 | (#/loadWindow *authentication-window-controller*)) |
---|
124 | (let ((window (authentication-window *authentication-window-controller*))) |
---|
125 | (if (or (null window) |
---|
126 | (%null-ptr-p window)) |
---|
127 | nil |
---|
128 | window))) |
---|
129 | |
---|
130 | (defun get-svn-auth-data () |
---|
131 | (let ((auth-window (get-auth-window))) |
---|
132 | (if auth-window |
---|
133 | (let ((window-status (#/runModalForWindow: (#/sharedApplication (@class ns-application)) |
---|
134 | auth-window))) |
---|
135 | (if (zerop window-status) |
---|
136 | nil |
---|
137 | (cons (#/stringValue (authentication-window-username-field *authentication-window-controller*)) |
---|
138 | (#/stringValue (authentication-window-password-field *authentication-window-controller*))))) |
---|
139 | nil))) |
---|