Allow for builds to run simultaneously.

By recording each package's archive-entry separately we are able to
build each recipe independently and then compile the archive contents
afterwards.
This commit is contained in:
Donald Curtis 2013-09-14 17:15:43 -07:00 committed by Steve Purcell
parent 13d1dc5c39
commit 49495e9b06
18 changed files with 520 additions and 270 deletions

1
.gitignore vendored
View file

@ -11,3 +11,4 @@
/html/updates.rss
/elpa
/html/build-status.json
/download_log.json.gz

View file

@ -3,6 +3,7 @@ PKGDIR := ./packages
RCPDIR := ./recipes
HTMLDIR := ./html
WORKDIR := ./working
WEBROOT := $$HOME/www
EMACS ?= emacs
EVAL := $(EMACS)
@ -16,14 +17,9 @@ endif
EVAL := $(EVAL) --no-site-file --batch -l package-build.el --eval
all: build json index
all: packages packages/archive-contents json index
## General rules
build:
@echo " • Building $$(ls -1 $(RCPDIR) | wc -l) recipes ..."
$(EVAL) "(package-build-all)"
html: index
index: json
@echo " • Building html index ..."
@ -43,8 +39,20 @@ clean-json:
@echo " • Removing json files ..."
-rm -vf html/archive.json html/recipes.json
sync:
rsync -avz --delete $(PKGDIR) $(HTMLDIR)/* $(WEBROOT)/
chmod -R go+rx $(WEBROOT)/packages/*
clean: clean-working clean-packages clean-json
packages: $(RCPDIR)/*
packages/archive-contents: packages/*.entry
@echo " • Updating $@ ..."
cleanup:
$(EVAL) '(package-build-cleanup)'
## Json rules
html/archive.json: packages/archive-contents
@ -66,7 +74,7 @@ $(RCPDIR)/.dirstamp: .FORCE
$(RCPDIR)/%: .FORCE
@echo " • Building recipe $(@F) ..."
$(EVAL) "(package-build-archive '$(@F))"
- timeout -k 60 600 $(EVAL) "(package-build-archive '$(@F))"
@echo " ✓ Wrote $$(ls -lsh $(PKGDIR)/$(@F)-*) "
@echo

19
etc/logrotate Normal file
View file

@ -0,0 +1,19 @@
/home/melpa/log/melpa*.log {
daily
create 0640 melpa melpa
compress
dateext
missingok
missingok
notifempty
rotate 36500
sharedscripts
prerotate
if [ -d /etc/logrotate.d/httpd-prerotate ]; then \
run-parts /etc/logrotate.d/httpd-prerotate; \
fi; \
endscript
postrotate
[ ! -f /home/melpa/var/run/nginx.pid ] || kill -USR1 `cat /home/melpa/var/run/nginx.pid`
endscript
}

91
etc/nginx Normal file
View file

@ -0,0 +1,91 @@
worker_processes 4;
pid /home/melpa/var/run/nginx.pid;
# error_log /dev/null crit;
daemon off;
events {
worker_connections 768;
# multi_accept on;
}
http {
##
# Basic Settings
##
sendfile on;
tcp_nopush on;
tcp_nodelay on;
keepalive_timeout 65;
types_hash_max_size 2048;
server_tokens off;
# server_names_hash_bucket_size 64;
server_name_in_redirect off;
charset utf-8;
include /etc/nginx/mime.types;
default_type application/octet-stream;
##
# Logging Settings
##
access_log /home/melpa/log/melpa.access.log combined;
error_log /home/melpa/log/melpa.error.log info;
##
# Gzip Settings
##
gzip on;
gzip_disable "msie6";
gzip_vary on;
gzip_proxied any;
gzip_comp_level 6;
gzip_buffers 16 8k;
gzip_http_version 1.1;
gzip_types text/plain text/css application/json application/x-javascript text/xml application/xml application/xml+rss text/javascript;
##
# nginx-naxsi config
##
# Uncomment it if you installed nginx-naxsi
##
#include /etc/nginx/naxsi_core.rules;
##
# nginx-passenger config
##
# Uncomment it if you installed nginx-passenger
##
#passenger_root /usr;
#passenger_ruby /usr/bin/ruby;
##
# Virtual Host Configs
##
server {
server_name melpa.milkbox.net;
server_tokens off;
server_name_in_redirect off;
root /home/melpa/www;
listen 1337;
error_page 500 502 503 504 /50x.html;
location = /50x.html {
root /var/www/nginx-default;
}
}
}

View file

@ -1,28 +0,0 @@
#!/bin/sh
:;exec emacs --script "$0" "$@"
(defun difference (left right)
"compare two lists"
(let ((caleft (car left))
(caright (car right)))
(cond
((not left) right)
((not right) left)
((string< caleft caright)
(cons caleft (difference (cdr left) right)))
((string< caright caleft)
(cons caright (difference left (cdr right))))
(t (difference (cdr left) (cdr right))))))
(defun stripstuff (fn)
"strip the date and extension"
(string-match "\\\(.*\\\)-[0-9]+\.\\\(el$\\\|tar$\\\)" fn)
(match-string 1 fn))
(mapc 'message
(difference
(sort (directory-files "recipes/" nil "[^.].*") 'string<)
(sort (mapcar 'stripstuff (directory-files "packages/" nil "[^.].*\\\(el$\\\|tar$\\\)")) 'string<)))

View file

@ -143,7 +143,7 @@ Output is written to the current buffer."
(let* ((default-directory (or dir default-directory))
(have-timeout (executable-find "timeout"))
(argv (if have-timeout
(append (list "timeout" "-k" "30" "1800" command) args)
(append (list "timeout" "-k" "60" "600" command) args)
(cons command args))))
(let ((exit-code (apply 'process-file (car argv) nil (current-buffer) t (cdr argv))))
(unless (zerop exit-code)
@ -176,7 +176,7 @@ the same arguments."
This is used to avoid exceeding the rate limit of 1 request per 2
seconds; the server cuts off after 10 requests in 20 seconds.")
(defvar pb/wiki-min-request-interval 2
(defvar pb/wiki-min-request-interval 3
"The shortest permissible interval between successive requests for Emacswiki URLs.")
(defmacro pb/with-wiki-rate-limit (&rest body)
@ -468,22 +468,19 @@ Optionally PRETTY-PRINT the data."
(car (read-from-string (pb/slurp-file file-name)))))
(defun pb/create-tar (file dir &optional files)
"Create a tar FILE containing the contents of DIR, or just FILES if non-nil.
The file is written to `package-build-working-dir'."
(let* ((default-directory package-build-working-dir))
(apply 'process-file
"tar" nil
(get-buffer-create "*package-build-checkout*")
nil "-cvf"
file
"--exclude=.svn"
"--exclude=CVS"
"--exclude=.git*"
"--exclude=_darcs"
"--exclude=.bzr"
"--exclude=.hg"
(or (mapcar (lambda (fn) (concat dir "/" fn)) files)
(list dir)))))
"Create a tar FILE containing the contents of DIR, or just FILES if non-nil."
(apply 'process-file
"tar" nil
(get-buffer-create "*package-build-checkout*")
nil "-cvf"
file
"--exclude=.svn"
"--exclude=CVS"
"--exclude=.git*"
"--exclude=_darcs"
"--exclude=.bzr"
"--exclude=.hg"
(or (mapcar (lambda (fn) (concat dir "/" fn)) files) (list dir))))
(defun pb/find-package-commentary (file-path)
@ -573,38 +570,26 @@ The file is written to `package-build-working-dir'."
(nth 1 pkgfile-info)))
(error "No define-package found in %s" file-path)))))
(defun pb/merge-package-info (pkg-info name version config)
(defun pb/merge-package-info (pkg-info name version)
"Return a version of PKG-INFO updated with NAME, VERSION and info from CONFIG.
If PKG-INFO is nil, an empty one is created."
(let* ((merged (or (copy-sequence pkg-info)
(vector name nil "No description available." version))))
(aset merged 0 name)
(aset merged 2 (format "%s [%s]"
(aref merged 2) (plist-get config :fetcher)))
(aset merged 3 version)
merged))
(defun pb/dump-archive-contents ()
"Dump the list of built packages back to the archive-contents file."
(pb/dump (cons 1 (package-build-archive-alist))
(expand-file-name "archive-contents"
package-build-archive-dir)))
(defun pb/add-to-archive-contents (pkg-info type)
"Add the built archive with info PKG-INFO and TYPE to `package-build-archive-alist'."
(defun pb/archive-entry (pkg-info type)
"Return the `cons' for the given package."
(let* ((name (intern (aref pkg-info 0)))
(requires (aref pkg-info 1))
(desc (or (aref pkg-info 2) "No description available."))
(version (aref pkg-info 3))
(existing (assq name (package-build-archive-alist))))
(when existing (package-build-archive-alist-remove existing))
(package-build-archive-alist-add
(cons name
(vector (version-to-list version)
requires
desc
type)))))
(version (aref pkg-info 3)))
(cons name
(vector (version-to-list version)
requires
desc
type))))
(defun pb/archive-file-name (archive-entry)
"Return the path of the file in which the package for ARCHIVE-ENTRY is stored."
@ -616,20 +601,29 @@ If PKG-INFO is nil, an empty one is created."
(format "%s-%s.%s" name version (if (eq flavour 'single) "el" "tar"))
package-build-archive-dir)))
(defun pb/remove-archive (archive-entry)
(defun pb/entry-file-name (archive-entry)
"Return the path of the file in which the package for ARCHIVE-ENTRY is stored."
(let* ((name (car archive-entry))
(pkg-info (cdr archive-entry))
(version (package-version-join (aref pkg-info 0))))
(expand-file-name
(format "%s-%s.entry" name version)
package-build-archive-dir)))
(defun pb/delete-file-if-exists (file)
"Delete FILE if it exists."
(when (file-exists-p file)
(delete-file file)))
(defun pb/remove-archive-files (archive-entry)
"Remove ARCHIVE-ENTRY from archive-contents, and delete associated file.
Note that the working directory (if present) is not deleted by
this function, since the archive list may contain another version
of the same-named package which is to be kept."
(message "Removing archive: %s" archive-entry)
(let ((archive-file (pb/archive-file-name archive-entry))
(readme-file (pb/readme-file-name (symbol-name (car archive-entry)))))
(when (file-exists-p archive-file)
(delete-file archive-file))
(when (file-exists-p readme-file)
(delete-file readme-file)))
(package-build-archive-alist-remove archive-entry))
(mapcar 'pb/delete-file-if-exists
(list (pb/archive-file-name archive-entry)
(pb/entry-file-name archive-entry))))
(defun pb/read-recipe (file-name)
(let ((pkg-info (pb/read-from-file file-name)))
@ -787,120 +781,123 @@ and a cl struct in Emacs HEAD. This wrapper normalises the results."
(package-desc-version desc))
desc)))
;;; Public interface
;;;###autoload
(defun package-build-archive (name)
"Build a package archive for package NAME."
(interactive (list (pb/package-name-completing-read)))
(let* ((file-name (symbol-name name))
(cfg (or (cdr (assoc name (package-build-recipe-alist)))
(rcp (or (cdr (assoc name (package-build-recipe-alist)))
(error "Cannot find package %s" file-name)))
(pkg-cwd
(pkg-working-dir
(file-name-as-directory
(expand-file-name file-name package-build-working-dir))))
(message "\n;;; %s\n" file-name)
(let* ((version (pb/checkout name cfg pkg-cwd))
(files (pb/expand-config-file-list pkg-cwd cfg))
(let* ((version (pb/checkout name rcp pkg-working-dir))
(files (pb/expand-config-file-list pkg-working-dir rcp))
(default-directory package-build-working-dir)
(start-time (current-time))
(old-archive-entry (assq name (package-build-archive-alist))))
archive-entry)
(setq archive-entry
(package-build-package version files
pkg-working-dir
package-build-archive-dir))
;; right before we create a new package, clean out the old one
(when old-archive-entry (pb/remove-archive old-archive-entry))
(cond
((not version)
(message "Unable to check out repository for %s" name))
((= 1 (length files))
(let* ((pkg-source (expand-file-name (caar files) pkg-cwd))
(pkg-target (expand-file-name
(concat file-name "-" version ".el")
package-build-archive-dir))
(pkg-info (pb/merge-package-info
(pb/get-package-info pkg-source)
file-name
version
cfg)))
(unless (string-equal (downcase (concat file-name ".el"))
(downcase (file-name-nondirectory pkg-source)))
(error "Single file %s does not match package name %s"
(file-name-nondirectory pkg-source) file-name))
(when (file-exists-p pkg-target)
(delete-file pkg-target t))
(copy-file pkg-source pkg-target)
(let ((enable-local-variables nil)
(make-backup-files nil))
(with-current-buffer (find-file pkg-target)
(pb/update-or-insert-version version)
(pb/ensure-ends-here-line pkg-source)
(write-file pkg-target nil)
(condition-case err
(pb/package-buffer-info-vec)
(error
(message "Warning: %S" err)))
(kill-buffer)))
(pb/write-pkg-readme (and (> (length pkg-info) 4) (aref pkg-info 4))
file-name)
(pb/add-to-archive-contents pkg-info 'single)))
((< 1 (length files))
(let* ((pkg-dir (concat file-name "-" version))
(pkg-file (concat file-name "-pkg.el"))
(pkg-file-source (or (pb/find-source-file pkg-file files)
pkg-file))
(file-source (concat file-name ".el"))
(pkg-source (or (pb/find-source-file file-source files)
file-source))
(pkg-info
(pb/merge-package-info
(let ((default-directory pkg-cwd))
(or (pb/get-pkg-file-info pkg-file-source)
;; some packages (like magit) provide name-pkg.el.in
(pb/get-pkg-file-info
(expand-file-name (concat pkg-file ".in")
(file-name-directory pkg-source)))
(pb/get-package-info pkg-source)))
file-name
version
cfg)))
(when (file-exists-p pkg-dir)
(delete-directory pkg-dir t nil))
(pb/copy-package-files files pkg-cwd pkg-dir)
(pb/write-pkg-file (expand-file-name pkg-file
(file-name-as-directory
(expand-file-name
pkg-dir
package-build-working-dir)))
pkg-info)
(pb/generate-info-files files pkg-cwd pkg-dir)
(pb/generate-dir-file files pkg-dir)
(pb/create-tar (expand-file-name (concat file-name "-" version ".tar")
package-build-archive-dir)
pkg-dir)
(let ((default-directory pkg-cwd))
(pb/write-pkg-readme (pb/find-package-commentary pkg-source)
file-name))
(delete-directory pkg-dir t nil)
(pb/add-to-archive-contents pkg-info 'tar)))
(t (error "Unable to find files matching recipe patterns")))
(pb/dump-archive-contents)
(pb/dump archive-entry
(expand-file-name (concat file-name "-" version ".entry")
package-build-archive-dir))
(message "Built in %.3fs, finished at %s"
(time-to-seconds (time-since start-time))
(current-time-string))
file-name)))
;;;###autload
(defun package-build-package (version files source-dir target-dir)
"Create VERSION of archive containing FILES from SOURCE-DIR and store in the TARGET_DIR.
Returns the archive entry for the package."
(cond
((not version)
(error "Unable to check out repository for %s" name))
((= 1 (length files))
(let* ((pkg-source (expand-file-name (caar files) source-dir))
(pkg-target (expand-file-name
(concat file-name "-" version ".el")
target-dir))
(pkg-info (pb/merge-package-info
(pb/get-package-info pkg-source)
file-name
version)))
(unless (string-equal (downcase (concat file-name ".el"))
(downcase (file-name-nondirectory pkg-source)))
(error "Single file %s does not match package name %s"
(file-name-nondirectory pkg-source) file-name))
(when (file-exists-p pkg-target)
(delete-file pkg-target t))
(copy-file pkg-source pkg-target)
(let ((enable-local-variables nil)
(make-backup-files nil))
(with-current-buffer (find-file pkg-target)
(pb/update-or-insert-version version)
(pb/ensure-ends-here-line pkg-source)
(write-file pkg-target nil)
(condition-case err
(pb/package-buffer-info-vec)
(error
(message "Warning: %S" err)))
(kill-buffer)))
(pb/write-pkg-readme (and (> (length pkg-info) 4) (aref pkg-info 4))
file-name)
(pb/archive-entry pkg-info 'single)))
((< 1 (length files))
(let* ((tmp-dir (file-name-as-directory (make-temp-file file-name t)))
(pkg-dir-name (concat file-name "-" version))
(pkg-tmp-dir (expand-file-name pkg-dir-name tmp-dir))
(pkg-file (concat file-name "-pkg.el"))
(pkg-file-source (or (pb/find-source-file pkg-file files)
pkg-file))
(file-source (concat file-name ".el"))
(pkg-source (or (pb/find-source-file file-source files)
file-source))
(pkg-info (pb/merge-package-info
(let ((default-directory source-dir))
(or (pb/get-pkg-file-info pkg-file-source)
;; some packages (like magit) provide name-pkg.el.in
(pb/get-pkg-file-info
(expand-file-name (concat pkg-file ".in")
(file-name-directory pkg-source)))
(pb/get-package-info pkg-source)))
file-name
version)))
(pb/copy-package-files files source-dir pkg-tmp-dir)
(pb/write-pkg-file (expand-file-name pkg-file
(file-name-as-directory pkg-tmp-dir))
pkg-info)
(pb/generate-info-files files source-dir pkg-tmp-dir)
(pb/generate-dir-file files pkg-tmp-dir)
(let ((default-directory tmp-dir))
(pb/create-tar (expand-file-name (concat file-name "-" version ".tar")
target-dir)
pkg-dir-name))
(let ((default-directory source-dir))
(pb/write-pkg-readme (pb/find-package-commentary pkg-source)
file-name))
(delete-directory pkg-tmp-dir t nil)
(pb/archive-entry pkg-info 'tar)))
(t (error "Unable to find files matching recipe patterns"))))
;;; Helpers for recipe authors
@ -958,8 +955,12 @@ and a cl struct in Emacs HEAD. This wrapper normalises the results."
(package-build-reinitialize)
(let ((pkg-name (intern (file-name-nondirectory (buffer-file-name)))))
(package-build-archive pkg-name)
(with-output-to-temp-buffer "*package-build-result*"
(pp (assoc pkg-name (package-build-archive-alist))))
(package-build-dump-archive-contents)
(save-current-buffer
(switch-to-buffer-other-window
(find-file-noselect
(expand-file-name "archive-contents" package-build-archive-dir) t))
(revert-buffer t t))
(when (yes-or-no-p "Install new package? ")
(package-install-file (pb/find-package-file pkg-name)))))
@ -998,11 +999,11 @@ and a cl struct in Emacs HEAD. This wrapper normalises the results."
"Remove previously-built packages that no longer have recipes."
(interactive)
(let* ((known-package-names (mapcar 'car (package-build-recipe-alist)))
(stale-archives (cl-loop for built in (package-build-archive-alist)
(stale-archives (cl-loop for built in (pb/archive-entries)
when (not (memq (car built) known-package-names))
collect built)))
(mapc 'pb/remove-archive stale-archives)
(pb/dump-archive-contents)))
(mapc 'pb/remove-archive-files stale-archives)
(package-build-dump-archive-contents)))
(defun package-build-recipe-alist ()
"Retun the list of avalailable packages."
@ -1011,28 +1012,38 @@ and a cl struct in Emacs HEAD. This wrapper normalises the results."
pb/recipe-alist-initialized t))
pb/recipe-alist)
(defun package-build-archive-alist-remove (elt)
"Remove ELT from the archive list using `remove' and return the new value."
(setq pb/archive-alist (remove elt pb/archive-alist)))
(defun package-build-archive-alist-add (elt)
"Add ELT to the archive list if it isn't there yet and return the new value."
(add-to-list 'pb/archive-alist elt))
(defun package-build-archive-alist ()
"Return the archive list."
(unless pb/archive-alist-initialized
(setq pb/archive-alist
(cdr (pb/read-from-file
(expand-file-name "archive-contents"
package-build-archive-dir)))
pb/archive-alist-initialized t))
pb/archive-alist)
(cdr (pb/read-from-file
(expand-file-name "archive-contents"
package-build-archive-dir))))
(defun package-build-reinitialize ()
(interactive)
(setq pb/recipe-alist-initialized nil
pb/archive-alist-initialized nil))
(setq pb/recipe-alist-initialized nil))
(defun package-build-dump-archive-contents (&optional fn)
"Dump the list of built packages back to the archive-contents file."
(unless fn
(setq fn (expand-file-name "archive-contents" package-build-archive-dir)))
(pb/dump (cons 1 (pb/archive-entries)) fn))
(defun pb/archive-entries ()
"Read all .entry files from the archive directory and return a list of all entries."
(let ((entries '()))
(dolist (new (mapcar 'pb/read-from-file
(directory-files package-build-archive-dir t
".*\.entry$"))
entries)
(let ((old (assq (car new) entries)))
(when old
(when (version-list-< (package-desc-vers (cdr new))
(package-desc-vers (cdr old)))
;; swap old and new
(cl-rotatef old new))
(pb/remove-archive-files old)
(setq entries (remove old entries)))
(add-to-list 'entries new)))))
;; Utility functions

41
scripts/bootstrap Executable file
View file

@ -0,0 +1,41 @@
#!/bin/bash
# \curl -L https://raw.github.com/milkypostman/melpa/fasterbuild/scripts/bootstrap | bash
SUDOENV='DEBIAN_FRONTEND=noninteractive'
cd ${HOME}
sudo ${SUDOENV} add-apt-repository -y ppa:cassou/emacs
sudo ${SUDOENV} apt-get update
sudo ${SUDOENV} apt-get -y upgrade
sudo ${SUDOENV} apt-get -y \
install \
subversion git cvs darcs curl bzr mercurial \
emacs24 emacs24-el emacs24-common-non-dfsg \
tmux make
# build the log stuff
mkdir -p log
cat > log/melpa.logrotate <<EOT
${HOME}/log/melpa.log {
rotate 10
weekly
compress
dateext
}
EOT
mkdir -p www
# ruby is used for templating
\curl -L https://get.rvm.io | bash -s stable
PATH=$PATH:$HOME/.rvm/bin
source "$HOME/.rvm/scripts/rvm"
rvm requirements
rvm install ruby-1.9.3
rvm use ruby-1.9.3 --default
echo "source ~/.profile" >> .bash_profile
git clone http://github.com/milkypostman/melpa
sudo reboot

View file

@ -1,67 +0,0 @@
#!/bin/bash
export LANG=en_US.UTF-8
WEBROOT=${WEBROOT:-$HOME/www}
function timestamp {
date "+%Y%m%d %H:%M %z"
}
function unix_timestamp {
date "+%s"
}
function melpa {
timestamp
timestamp > $WEBROOT/status.txt
echo "building..." >> $WEBROOT/status.txt
MELPADIR=${MELPADIR:-$HOME/melpa}
MELPABRANCH=${MELPABRANCH:-master}
PATH=$HOME/.cabal/bin:$HOME/usr/bin:$HOME/bin:$PATH
[[ -s "$HOME/.rvm/scripts/rvm" ]] && source "$HOME/.rvm/scripts/rvm"
ENVLOG=$HOME/log/melpaenv.log
env > ${ENVLOG}
STDOUT=`mktemp`
STDERR=`mktemp`
## git pull
cd ${MELPADIR}
git pull origin ${MELPABRANCH} &>> ${STDOUT}
echo >> ${STDOUT}
MELPASTDOUT=`mktemp`
## run the script
cd ${MELPADIR}
make 1>> ${MELPASTDOUT} 2>> ${STDERR}
## sync to the web directory
rsync -avz --delete ${MELPADIR}/packages ${MELPADIR}/html/. ${WEBROOT}/ 1>> ${STDOUT} 2>> ${STDERR}
chmod -R go+rx ${WEBROOT}/packages/*
/usr/sbin/logrotate -s $HOME/log/logrotate.state $HOME/log/melpa.logrotate 1>> ${STDOUT} 2>> ${STDERR}
EMAIL=`mktemp`
echo "Subject: Melpa status `timestamp`" > ${EMAIL}
cat ${MELPASTDOUT} ${STDOUT} ${ENVLOG} ${STDERR} >> ${EMAIL}
/usr/sbin/sendmail dcurtis@milkbox.net < ${EMAIL}
cat ${ENVLOG} ${STDERR} ${STDOUT} | tee $WEBROOT/lastrun.txt
timestamp > $WEBROOT/status.txt
echo "completed" >> $WEBROOT/status.txt
echo '{"completed":' `unix_timestamp` '}' > $WEBROOT/build-status.json
}
if [[ `cat $WEBROOT/updatemelpa.txt` == 1 ]] ; then
echo "Running MELPA"
echo "2" > $WEBROOT/updatemelpa.txt
melpa
echo "0" > $WEBROOT/updatemelpa.txt
fi

3
scripts/env Normal file
View file

@ -0,0 +1,3 @@
MELPA_HOME=${MELPA_HOME:-${HOME}/melpa}
MELPA_BRANCH=${MELPA_BRANCH:-`git rev-parse --abbrev-ref HEAD`}
MELPA_WWW=${MELPA_WWW:-${HOME}/www}

35
scripts/expired Executable file
View file

@ -0,0 +1,35 @@
#!/bin/sh
:;exec emacs --script "$0" "$@"
(defun missing-packages (recipes packages)
"Show elements of RECIPES that are no in PACKAGES."
(let (missing)
(while recipes
(let ((recipe (car recipes))
(package (car packages)))
(cond
((or (not package) (string< recipe package))
(setq missing (cons recipe missing)))
((string< package recipe)
(error "Package has no recipe: %s" package))
(t (setq packages (cdr packages)))))
(setq recipes (cdr recipes)))
(reverse missing)))
(defun stripstuff (fn)
"Strip the date and extension from FN."
(string-match "\\(.*\\)-[0-9]+\\.[0-9]+\\.\\(el$\\|tar$\\)" fn)
(match-string 1 fn))
(add-to-list 'load-path (expand-file-name ".." (file-name-directory load-file-name)))
(require 'package-build)
(dolist (entry-file (directory-files package-build-archive-dir t ".*\.entry$"))
(when (> (time-to-seconds
(time-subtract (current-time)
(nth 5 (file-attributes entry-file))))
(* 23 60 60))
(princ (symbol-name (car (pb/read-from-file entry-file))))
(princ "\n")))

33
scripts/missing Executable file
View file

@ -0,0 +1,33 @@
#!/bin/sh
:;exec emacs --script "$0" "$@"
(defun missing-packages (recipes packages)
"Show elements of RECIPES that are no in PACKAGES."
(let (missing)
(while recipes
(let ((recipe (car recipes))
(package (car packages)))
(cond
((or (not package) (string< recipe package))
(setq missing (cons recipe missing)))
((string< package recipe)
(error "Package has no recipe: %s" package))
(t (setq packages (cdr packages)))))
(setq recipes (cdr recipes)))
(reverse missing)))
(defun package-sans-version (fn)
"Strip the date and extension from FN."
(string-match "\\(.*\\)-[0-9]+\\.[0-9]+\\.\\(el$\\|tar$\\)" fn)
(match-string 1 fn))
(princ
(mapconcat 'identity
(missing-packages
(sort (directory-files "recipes/" nil "^[^.].*") 'string<)
(sort (delete-dups
(mapcar
'package-sans-version
(directory-files "packages/" nil "^[^.].*\\\(el$\\\|tar$\\\)")))
'string<)) "\n"))
(princ "\n")

28
scripts/parallel_build_all Executable file
View file

@ -0,0 +1,28 @@
#!/bin/bash -e
export LANG=en_US.UTF-8
source $(dirname ${0})/env
function unix_timestamp {
date "+%s"
}
function kill_all_jobs { jobs -p | xargs kill; }
trap kill_all_jobs SIGINT SIGTERM
function build_all {
PATH=$HOME/.cabal/bin:$HOME/usr/bin:$HOME/bin:$PATH
## run the script
cd ${MELPA_HOME}
# grep --files-with-match wiki recipes/* | xargs make -j1 &
make -j1 $(grep --files-with-match wiki recipes/*) &
# grep --files-without-match wiki recipes/* | xargs make -j4 &
make -j4 $(grep --files-without-match wiki recipes/*) &
wait
echo '{"completed":' `unix_timestamp` '}' > ${MELPA_WWW}/build-status.json
}
build_all

View file

@ -10,9 +10,10 @@ import re
import sys
import time
import tempfile
from operator import or_
LOGFILE = "/var/log/nginx/melpa/melpa.access.log"
LOGREGEX = r'(?P<ip>[\d.]+) [ -]+ \[(?P<date>[\w/: -]+)\] ' \
LOGFILE = "/home/melpa/log/melpa.access.log"
LOGREGEX = r'(?P<ip>[\d.]+) [ -]+ \[(?P<date>[\w/: +-]+)\] ' \
r'"GET /packages/(?P<package>[^ ]+)-[0-9.]+.(?:el|tar) ' \
r'HTTP/\d.\d" 200'
@ -31,7 +32,7 @@ def json_dump(data, jsonfile, indent=None):
"""
jsonfiy `data`
"""
return json.dump(data, jsonfile, default=json_handler, indent=indent)
return json.dump(data, jsonfile, default=json_handler, indent=indent, encoding='utf-8')
def datetime_parser(dct):
@ -52,6 +53,10 @@ def parse_val(val):
return val
def ip_to_number(ip):
return reduce(or_, ((int(n) << (i*8)) for i, n in enumerate(
reversed(ip.split('.')))), 0)
def parse_logfile(logfilename, pkg_ip_time):
"""
"""
@ -65,12 +70,12 @@ def parse_logfile(logfilename, pkg_ip_time):
count = 0
for line in logfile:
match = logre.match(line)
if match is None:
continue
# Convert ips to four character strings.
ip = match.group('ip')
dtstamp = int(time.mktime(
datetime.strptime(match.group('date').split()[0],

21
service/builder Executable file
View file

@ -0,0 +1,21 @@
#!/bin/bash -e
export HOME=/home/melpa
cd ${HOME}/melpa
source $HOME/melpa/scripts/env
## git pull
cd ${MELPA_HOME}
git fetch origin
git reset --hard origin/${MELPA_BRANCH}
git pull origin ${MELPA_BRANCH}
echo
# Build all the packages.
scripts/parallel_build_all
echo '{"completed":' `date "+%s"` '}' > /home/melpa/www/build-status.json
# Sleep for an hour before rebuilding.
sleep 1h

4
service/nginx Executable file
View file

@ -0,0 +1,4 @@
#!/bin/bash -e
/usr/sbin/nginx -g 'error_log /dev/null crit;' -c ~/etc/nginx

8
service/process_log Executable file
View file

@ -0,0 +1,8 @@
#!/bin/bash -e
cd /home/melpa/melpa
/usr/bin/python /home/melpa/melpa/scripts/process_log.py
/usr/sbin/logrotate -s /home/melpa/var/lib/logrotate/status /home/melpa/etc/logrotate
sleep 6h

24
service/reporter Executable file
View file

@ -0,0 +1,24 @@
#!/bin/bash -e
# Service for reporting missing and old packages.
export HOME=/home/melpa
BODY=`mktemp`
cd ${HOME}/melpa
echo "To: MP <dcurtis@milkbox.net>" > ${BODY}
echo "Subject: [MELPA] `date "+%Y%m%d %H:%M %z"`" >> ${BODY}
echo >> ${BODY}
echo "# Old Packages" >> ${BODY}
echo >> ${BODY}
scripts/expired >> ${BODY}
echo >> ${BODY}
echo "# Missing Packages" >> ${BODY}
echo >> ${BODY}
scripts/missing >> ${BODY}
/usr/sbin/sendmail -t < ${BODY}
sleep 12h

13
service/syncer Executable file
View file

@ -0,0 +1,13 @@
#!/bin/bash -e
export HOME=/home/melpa
cd ${HOME}/melpa
[[ -s "$HOME/.rvm/scripts/rvm" ]] && source "$HOME/.rvm/scripts/rvm"
make cleanup
make json
make html
make sync
# Sync every 5 minutes.
sleep 5m