source: trunk/source/cocoa-ide/ide-self-update.lisp @ 9609

Last change on this file since 9609 was 9609, checked in by mikel, 13 years ago

more code for svn self update auth process

File size: 6.1 KB
1;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: cl-user -*-
2;;;; ***********************************************************************
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
10;;;; ***********************************************************************
12(in-package :ccl)
14;;; IDE: decide how and whether to handle cvs self-updates.
15;;; see the cvs/svn code in update-ccl in compile-ccl.lisp
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)
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
47;;; ---------------------
48;;; returns TRUE if P is really an existing directory that appears to
49;;; contain valid Subversion metadata; FALSE otherwise
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))))
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
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)))
83(defun parse-svn-info (info-string)
84  (let ((info-lines (split-lines info-string)))
85    (mapcar #'split-svn-info-line info-lines)))
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))))
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
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))
104(objc:defmethod #/windowNibName ((self authentication-window-controller))
105  #@"Authenticate")
107(objc:defmethod #/authOkay: ((self authentication-window-controller) sender)
108  (declare (ignore sender))
109  (#/stopModalWithCode: (#/sharedApplication (@class ns-application)) 1)
110  (#/orderOut: (authentication-window *authentication-window-controller*) +null-ptr+))
112(objc:defmethod #/authCancel: ((self authentication-window-controller) sender)
113  (declare (ignore sender))
114  (#/stopModalWithCode: (#/sharedApplication (@class ns-application)) 2)
115  (#/orderOut: (authentication-window *authentication-window-controller*) +null-ptr+))
117(defparameter *authentication-window-controller* nil)
119(defun get-auth-window ()
120  (unless *authentication-window-controller*
121    (setf *authentication-window-controller* 
122          (make-instance 'authentication-window-controller))
123    (#/initWithWindowNibName: *authentication-window-controller* #@"Authenticate"))
124  (unless (#/isWindowLoaded *authentication-window-controller*)
125    (#/loadWindow *authentication-window-controller*))
126  (let ((window (authentication-window *authentication-window-controller*)))
127    (if (or (null window)
128            (%null-ptr-p window))
129        nil
130        window)))
132(defun get-svn-auth-data ()
133  (let ((auth-window (get-auth-window)))
134    (if auth-window
135        (let ((window-status (#/runModalForWindow: (#/sharedApplication (@class ns-application))
136                                                   auth-window)))
137          (if (zerop window-status)
138              nil
139              (cons (#/stringValue (authentication-window-username-field *authentication-window-controller*))
140                    (#/stringValue (authentication-window-password-field *authentication-window-controller*)))))
141        nil)))
Note: See TracBrowser for help on using the repository browser.