Merge pull request #1196 from milkypostman/fasterbuild

faster builds
This commit is contained in:
Donald Ephraim Curtis 2013-11-25 09:31:34 -08:00
commit d3c630242e
18 changed files with 523 additions and 270 deletions

1
.gitignore vendored
View file

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

View file

@ -3,7 +3,9 @@ PKGDIR := ./packages
RCPDIR := ./recipes RCPDIR := ./recipes
HTMLDIR := ./html HTMLDIR := ./html
WORKDIR := ./working WORKDIR := ./working
WEBROOT := $$HOME/www
EMACS ?= emacs EMACS ?= emacs
SLEEP ?= 0
EVAL := $(EMACS) EVAL := $(EMACS)
@ -16,14 +18,9 @@ endif
EVAL := $(EVAL) --no-site-file --batch -l package-build.el --eval EVAL := $(EVAL) --no-site-file --batch -l package-build.el --eval
all: build json index all: packages packages/archive-contents json index
## General rules ## General rules
build:
@echo " • Building $$(ls -1 $(RCPDIR) | wc -l) recipes ..."
$(EVAL) "(package-build-all)"
html: index html: index
index: json index: json
@echo " • Building html index ..." @echo " • Building html index ..."
@ -43,8 +40,20 @@ clean-json:
@echo " • Removing json files ..." @echo " • Removing json files ..."
-rm -vf html/archive.json html/recipes.json -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 clean: clean-working clean-packages clean-json
packages: $(RCPDIR)/*
packages/archive-contents: packages/*.entry
@echo " • Updating $@ ..."
cleanup:
$(EVAL) '(package-build-cleanup)'
## Json rules ## Json rules
html/archive.json: packages/archive-contents html/archive.json: packages/archive-contents
@ -66,9 +75,11 @@ $(RCPDIR)/.dirstamp: .FORCE
$(RCPDIR)/%: .FORCE $(RCPDIR)/%: .FORCE
@echo " • Building recipe $(@F) ..." @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 " ✓ Wrote $$(ls -lsh $(PKGDIR)/$(@F)-*) "
@echo " Sleeping for $(SLEEP) ..."
sleep $(SLEEP)
@echo @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)) (let* ((default-directory (or dir default-directory))
(have-timeout (executable-find "timeout")) (have-timeout (executable-find "timeout"))
(argv (if have-timeout (argv (if have-timeout
(append (list "timeout" "-k" "30" "1800" command) args) (append (list "timeout" "-k" "60" "600" command) args)
(cons command args)))) (cons command args))))
(let ((exit-code (apply 'process-file (car argv) nil (current-buffer) t (cdr argv)))) (let ((exit-code (apply 'process-file (car argv) nil (current-buffer) t (cdr argv))))
(unless (zerop exit-code) (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 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.") 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.") "The shortest permissible interval between successive requests for Emacswiki URLs.")
(defmacro pb/with-wiki-rate-limit (&rest body) (defmacro pb/with-wiki-rate-limit (&rest body)
@ -468,9 +468,7 @@ Optionally PRETTY-PRINT the data."
(car (read-from-string (pb/slurp-file file-name))))) (car (read-from-string (pb/slurp-file file-name)))))
(defun pb/create-tar (file dir &optional files) (defun pb/create-tar (file dir &optional files)
"Create a tar FILE containing the contents of DIR, or just FILES if non-nil. "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 (apply 'process-file
"tar" nil "tar" nil
(get-buffer-create "*package-build-checkout*") (get-buffer-create "*package-build-checkout*")
@ -482,8 +480,7 @@ The file is written to `package-build-working-dir'."
"--exclude=_darcs" "--exclude=_darcs"
"--exclude=.bzr" "--exclude=.bzr"
"--exclude=.hg" "--exclude=.hg"
(or (mapcar (lambda (fn) (concat dir "/" fn)) files) (or (mapcar (lambda (fn) (concat dir "/" fn)) files) (list dir))))
(list dir)))))
(defun pb/find-package-commentary (file-path) (defun pb/find-package-commentary (file-path)
@ -573,38 +570,26 @@ The file is written to `package-build-working-dir'."
(nth 1 pkgfile-info))) (nth 1 pkgfile-info)))
(error "No define-package found in %s" file-path))))) (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. "Return a version of PKG-INFO updated with NAME, VERSION and info from CONFIG.
If PKG-INFO is nil, an empty one is created." If PKG-INFO is nil, an empty one is created."
(let* ((merged (or (copy-sequence pkg-info) (let* ((merged (or (copy-sequence pkg-info)
(vector name nil "No description available." version)))) (vector name nil "No description available." version))))
(aset merged 0 name) (aset merged 0 name)
(aset merged 2 (format "%s [%s]"
(aref merged 2) (plist-get config :fetcher)))
(aset merged 3 version) (aset merged 3 version)
merged)) merged))
(defun pb/dump-archive-contents () (defun pb/archive-entry (pkg-info type)
"Dump the list of built packages back to the archive-contents file." "Return the `cons' for the given package."
(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'."
(let* ((name (intern (aref pkg-info 0))) (let* ((name (intern (aref pkg-info 0)))
(requires (aref pkg-info 1)) (requires (aref pkg-info 1))
(desc (or (aref pkg-info 2) "No description available.")) (desc (or (aref pkg-info 2) "No description available."))
(version (aref pkg-info 3)) (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 (cons name
(vector (version-to-list version) (vector (version-to-list version)
requires requires
desc desc
type))))) type))))
(defun pb/archive-file-name (archive-entry) (defun pb/archive-file-name (archive-entry)
"Return the path of the file in which the package for ARCHIVE-ENTRY is stored." "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")) (format "%s-%s.%s" name version (if (eq flavour 'single) "el" "tar"))
package-build-archive-dir))) 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. "Remove ARCHIVE-ENTRY from archive-contents, and delete associated file.
Note that the working directory (if present) is not deleted by Note that the working directory (if present) is not deleted by
this function, since the archive list may contain another version this function, since the archive list may contain another version
of the same-named package which is to be kept." of the same-named package which is to be kept."
(message "Removing archive: %s" archive-entry) (message "Removing archive: %s" archive-entry)
(let ((archive-file (pb/archive-file-name archive-entry)) (mapcar 'pb/delete-file-if-exists
(readme-file (pb/readme-file-name (symbol-name (car archive-entry))))) (list (pb/archive-file-name archive-entry)
(when (file-exists-p archive-file) (pb/entry-file-name archive-entry))))
(delete-file archive-file))
(when (file-exists-p readme-file)
(delete-file readme-file)))
(package-build-archive-alist-remove archive-entry))
(defun pb/read-recipe (file-name) (defun pb/read-recipe (file-name)
(let ((pkg-info (pb/read-from-file file-name))) (let ((pkg-info (pb/read-from-file file-name)))
@ -787,42 +781,56 @@ and a cl struct in Emacs HEAD. This wrapper normalises the results."
(package-desc-version desc)) (package-desc-version desc))
desc))) desc)))
;;; Public interface ;;; Public interface
;;;###autoload ;;;###autoload
(defun package-build-archive (name) (defun package-build-archive (name)
"Build a package archive for package NAME." "Build a package archive for package NAME."
(interactive (list (pb/package-name-completing-read))) (interactive (list (pb/package-name-completing-read)))
(let* ((file-name (symbol-name name)) (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))) (error "Cannot find package %s" file-name)))
(pkg-cwd (pkg-working-dir
(file-name-as-directory (file-name-as-directory
(expand-file-name file-name package-build-working-dir)))) (expand-file-name file-name package-build-working-dir))))
(message "\n;;; %s\n" file-name) (message "\n;;; %s\n" file-name)
(let* ((version (pb/checkout name cfg pkg-cwd)) (let* ((version (pb/checkout name rcp pkg-working-dir))
(files (pb/expand-config-file-list pkg-cwd cfg)) (files (pb/expand-config-file-list pkg-working-dir rcp))
(default-directory package-build-working-dir) (default-directory package-build-working-dir)
(start-time (current-time)) (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 (pb/dump archive-entry
(when old-archive-entry (pb/remove-archive old-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 (cond
((not version) ((not version)
(message "Unable to check out repository for %s" name)) (error "Unable to check out repository for %s" name))
((= 1 (length files)) ((= 1 (length files))
(let* ((pkg-source (expand-file-name (caar files) pkg-cwd)) (let* ((pkg-source (expand-file-name (caar files) source-dir))
(pkg-target (expand-file-name (pkg-target (expand-file-name
(concat file-name "-" version ".el") (concat file-name "-" version ".el")
package-build-archive-dir)) target-dir))
(pkg-info (pb/merge-package-info (pkg-info (pb/merge-package-info
(pb/get-package-info pkg-source) (pb/get-package-info pkg-source)
file-name file-name
version version)))
cfg)))
(unless (string-equal (downcase (concat file-name ".el")) (unless (string-equal (downcase (concat file-name ".el"))
(downcase (file-name-nondirectory pkg-source))) (downcase (file-name-nondirectory pkg-source)))
(error "Single file %s does not match package name %s" (error "Single file %s does not match package name %s"
@ -844,19 +852,19 @@ and a cl struct in Emacs HEAD. This wrapper normalises the results."
(pb/write-pkg-readme (and (> (length pkg-info) 4) (aref pkg-info 4)) (pb/write-pkg-readme (and (> (length pkg-info) 4) (aref pkg-info 4))
file-name) file-name)
(pb/archive-entry pkg-info 'single)))
(pb/add-to-archive-contents pkg-info 'single)))
((< 1 (length files)) ((< 1 (length files))
(let* ((pkg-dir (concat file-name "-" version)) (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 (concat file-name "-pkg.el"))
(pkg-file-source (or (pb/find-source-file pkg-file files) (pkg-file-source (or (pb/find-source-file pkg-file files)
pkg-file)) pkg-file))
(file-source (concat file-name ".el")) (file-source (concat file-name ".el"))
(pkg-source (or (pb/find-source-file file-source files) (pkg-source (or (pb/find-source-file file-source files)
file-source)) file-source))
(pkg-info (pkg-info (pb/merge-package-info
(pb/merge-package-info (let ((default-directory source-dir))
(let ((default-directory pkg-cwd))
(or (pb/get-pkg-file-info pkg-file-source) (or (pb/get-pkg-file-info pkg-file-source)
;; some packages (like magit) provide name-pkg.el.in ;; some packages (like magit) provide name-pkg.el.in
(pb/get-pkg-file-info (pb/get-pkg-file-info
@ -864,42 +872,31 @@ and a cl struct in Emacs HEAD. This wrapper normalises the results."
(file-name-directory pkg-source))) (file-name-directory pkg-source)))
(pb/get-package-info pkg-source))) (pb/get-package-info pkg-source)))
file-name file-name
version version)))
cfg)))
(when (file-exists-p pkg-dir) (pb/copy-package-files files source-dir pkg-tmp-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 (pb/write-pkg-file (expand-file-name pkg-file
(file-name-as-directory (file-name-as-directory pkg-tmp-dir))
(expand-file-name
pkg-dir
package-build-working-dir)))
pkg-info) pkg-info)
(pb/generate-info-files files pkg-cwd pkg-dir) (pb/generate-info-files files source-dir pkg-tmp-dir)
(pb/generate-dir-file files pkg-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") (pb/create-tar (expand-file-name (concat file-name "-" version ".tar")
package-build-archive-dir) target-dir)
pkg-dir) pkg-dir-name))
(let ((default-directory pkg-cwd)) (let ((default-directory source-dir))
(pb/write-pkg-readme (pb/find-package-commentary pkg-source) (pb/write-pkg-readme (pb/find-package-commentary pkg-source)
file-name)) file-name))
(delete-directory pkg-dir t nil) (delete-directory pkg-tmp-dir t nil)
(pb/add-to-archive-contents pkg-info 'tar))) (pb/archive-entry pkg-info 'tar)))
(t (error "Unable to find files matching recipe patterns"))))
(t (error "Unable to find files matching recipe patterns")))
(pb/dump-archive-contents)
(message "Built in %.3fs, finished at %s"
(time-to-seconds (time-since start-time))
(current-time-string))
file-name)))
;;; Helpers for recipe authors ;;; Helpers for recipe authors
@ -958,8 +955,12 @@ and a cl struct in Emacs HEAD. This wrapper normalises the results."
(package-build-reinitialize) (package-build-reinitialize)
(let ((pkg-name (intern (file-name-nondirectory (buffer-file-name))))) (let ((pkg-name (intern (file-name-nondirectory (buffer-file-name)))))
(package-build-archive pkg-name) (package-build-archive pkg-name)
(with-output-to-temp-buffer "*package-build-result*" (package-build-dump-archive-contents)
(pp (assoc pkg-name (package-build-archive-alist)))) (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? ") (when (yes-or-no-p "Install new package? ")
(package-install-file (pb/find-package-file pkg-name))))) (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." "Remove previously-built packages that no longer have recipes."
(interactive) (interactive)
(let* ((known-package-names (mapcar 'car (package-build-recipe-alist))) (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)) when (not (memq (car built) known-package-names))
collect built))) collect built)))
(mapc 'pb/remove-archive stale-archives) (mapc 'pb/remove-archive-files stale-archives)
(pb/dump-archive-contents))) (package-build-dump-archive-contents)))
(defun package-build-recipe-alist () (defun package-build-recipe-alist ()
"Retun the list of avalailable packages." "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-initialized t))
pb/recipe-alist) 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 () (defun package-build-archive-alist ()
"Return the archive list." "Return the archive list."
(unless pb/archive-alist-initialized
(setq pb/archive-alist
(cdr (pb/read-from-file (cdr (pb/read-from-file
(expand-file-name "archive-contents" (expand-file-name "archive-contents"
package-build-archive-dir))) package-build-archive-dir))))
pb/archive-alist-initialized t))
pb/archive-alist)
(defun package-build-reinitialize () (defun package-build-reinitialize ()
(interactive) (interactive)
(setq pb/recipe-alist-initialized nil (setq pb/recipe-alist-initialized nil))
pb/archive-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 ;; 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 SLEEP=2 -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 sys
import time import time
import tempfile import tempfile
from operator import or_
LOGFILE = "/var/log/nginx/melpa/melpa.access.log" LOGFILE = "/home/melpa/log/melpa.access.log"
LOGREGEX = r'(?P<ip>[\d.]+) [ -]+ \[(?P<date>[\w/: -]+)\] ' \ LOGREGEX = r'(?P<ip>[\d.]+) [ -]+ \[(?P<date>[\w/: +-]+)\] ' \
r'"GET /packages/(?P<package>[^ ]+)-[0-9.]+.(?:el|tar) ' \ r'"GET /packages/(?P<package>[^ ]+)-[0-9.]+.(?:el|tar) ' \
r'HTTP/\d.\d" 200' r'HTTP/\d.\d" 200'
@ -31,7 +32,7 @@ def json_dump(data, jsonfile, indent=None):
""" """
jsonfiy `data` 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): def datetime_parser(dct):
@ -52,6 +53,10 @@ def parse_val(val):
return 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): def parse_logfile(logfilename, pkg_ip_time):
""" """
""" """
@ -65,12 +70,12 @@ def parse_logfile(logfilename, pkg_ip_time):
count = 0 count = 0
for line in logfile: for line in logfile:
match = logre.match(line) match = logre.match(line)
if match is None: if match is None:
continue continue
# Convert ips to four character strings.
ip = match.group('ip') ip = match.group('ip')
dtstamp = int(time.mktime( dtstamp = int(time.mktime(
datetime.strptime(match.group('date').split()[0], 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