anchor.diff:      (format t "Removed projects: ~{~A~^, ~}."
   	    (mapcar #'name removed))))
   
  -
  -(defun publish-alpha (&key keep)
  -  (let ((update (merge-dists "quicklisp" "mock" :keep keep))
  -	(*dist-bucket* "alpha.quicklisp.org")
  -	(zs3:*credentials* (zs3:file-credentials "~/.qlalpha")))
  +(defun make-alpha-update (&key keep (dist "mock"))
  +  (let ((update (merge-dists "quicklisp" dist :keep keep)))
       (setf (name update) "qlalpha"
   	  (version update) (date-for-today))
  -    (upload-new-releases update)
  -    (write-indexes update "/tmp/qlalpha/")
  -    (upload-distinfo-files update "/tmp/qlalpha/")
  -    (put-to-s3-url "/tmp/qlalpha/distinfo.txt"
  -		   "http://alpha.quicklisp.org/dist/qlalpha.txt"
  -		   :overwrite t :content-type "text/plain")
  -    (write-dist-versions-file "qlalpha"
  -			      "/tmp/qlalpha/qlalpha-versions.txt")
  -    (put-to-s3-url "/tmp/qlalpha/qlalpha-versions.txt"
  -		   "http://alpha.quicklisp.org/dist/qlalpha-versions.txt"
  -		   :overwrite t :content-type "text/plain")))
  +    update))
  +
  +(defun call-with-retrying (fun)
  +  (handler-bind
  +      ((error (lambda (condition)
  +		(when (find-restart 'retry condition)
  +		  (warn "Retrying after condition: ~A" condition)
  +		  (invoke-restart 'retry)))))
  +    (funcall fun)))
  +
  +(defmacro with-retrying (&body body)
  +  `(call-with-retrying (lambda () ,@body)))
  +
  +(defun s3-url-exists (url)
  +  (multiple-value-bind (bucket key)
  +      (s3-components url)
  +    (s3-object-exists bucket key)))
  +
  +(defun sanity-check-dist-uploads (dist)
  +  (let ((releases (provided-releases dist)))
  +    (dolist (release releases)
  +      (unless (s3-url-exists (archive-url release))
  +	(warn "No archive file found for ~A" (name release))))))
  +
  +(defun publish-alpha (&key keep (dist "mock"))
  +  (let* ((*dist-bucket* "alpha.quicklisp.org")
  +	 (update (make-alpha-update :keep keep :dist dist))
  +	 (zs3:*credentials* (zs3:file-credentials "~/.qlalpha")))
  +    (with-retrying
  +      (upload-new-releases update :overwrite nil)
  +      (write-indexes update "/tmp/qlalpha/")
  +      (upload-distinfo-files update "/tmp/qlalpha/")
  +      (put-to-s3-url "/tmp/qlalpha/distinfo.txt"
  +		     "http://alpha.quicklisp.org/dist/qlalpha.txt"
  +		     :overwrite t :content-type "text/plain")
  +      (write-dist-versions-file "qlalpha"
  +				"/tmp/qlalpha/qlalpha-versions.txt")
  +      (put-to-s3-url "/tmp/qlalpha/qlalpha-versions.txt"
  +		     "http://alpha.quicklisp.org/dist/qlalpha-versions.txt"
  +		     :overwrite t :content-type "text/plain"))
  +    update))
  +
  +(defun alpha-problems (dist)
  +  (dolist (release (provided-releases dist))
  +    (let ((s3-url-exists-p (s3-url-exists (archive-url release)))
  +	  (file-exists-p (probe-file (local-archive-file release))))
  +      (when (and (not s3-url-exists-p)
  +		 (not file-exists-p))
  +	(print release)))))
  
positive.code:     copy))
  
  (defmethod find-system-in-dist (name (dist merged-dist))
    (error "Not supported"))
  
  (defgeneric (setf find-release-in-dist) (new-release name dist))
  
  
negative.code:         (m2 (archive-md5 r2))
          (s1 (archive-content-sha1 r1))
          (s2 (archive-content-sha1 r2))
  	(size1 (archive-size r1))
  	(size2 (archive-size r2))
          (name (project-name r1))
          (v1 nil)
          (v2 nil)
  