#!/usr/bin/clisp -ansi -q -q
(setq *print-case* :downcase)
;;;
;;; Design note:
;;;
;;; Normally, one prefers the `-modern' option for a `case-sensitive'
;;; world; in which case, the top two lines above should instead read:
;;;
;;;   #!/usr/bin/clisp -ansi -modern -q -q
;;;
;;; However, I got errors when running in `--gui' mode (under clisp 2.49):
;;;
;;;   (root-shell)# wp-mirror --gui
;;;   WARNING: One should not change the case sensitiveness of #<package xlib>.
;;;   WARNING: One should not change the case inversion of #<package xlib>.
;;;   *** - subtypep: invalid type specification xlib::|x-type-error|
;;;
;;; First two errors appear while executing    `(require "clx")'.
;;; Last error (fatal) appears while executing `(xlib:display-roots display)'.
;;;
;;; I filed Debian Bug Report: #691519
;;; 

;;;;--------------------------------------------------------------------------+
;;;; WP-MIRROR is a free utility for mirroring a set of Wikipedias.           |
;;;;--------------------------------------------------------------------------+


(defconstant *copyright-license-and-disclaimer*
"Copyright (C) 2011-2014 Dr. Kent L. Miller. All rights reserved.

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.

This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY\; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>")


(defconstant *version* "wp-mirror 0.7.4")


;;;;--------------------------------------------------------------------------+
;;;; Internationalization:                                                    |
;;;;--------------------------------------------------------------------------+

;;;
;;; Design note:
;;;
;;; Lessons learned: The author recommends addressing `i18n' early in
;;; the design process.  The approach used here is as follows:
;;;
;;; 1) The `Makefile' has a `build' target.  This target invokes
;;; `xgettext' which scrapes this file for strings and writes them to
;;; `wp-mirror.pot'.
;;; 2) The `wp-mirror.pot' file can be translated.
;;; 3) Any translated `pot' file can be distributed with `wp-mirror'.
;;; 4) Translated `pot' files should be installed under the appropriate
;;;    directory `/usr/share/locale/<lang-code>/LC_MESSAGES/'.
;;; 5) The lisp function `_' takes the original string `msgid', and
;;;    looks up its translation from the installed `pot' file.
;;; 6) The lisp function name, `_', is just one unobtrusive character.
;;;    This was choosen so as to minimize the programmer's work load.
;;;    The programmer must only wrap each message like so:
;;;
;;;      "msgid" --> (_ "msgid")
;;;

(setf (i18n:textdomaindir "wp-mirror") "./")
(defun _ (msgid) (i18n:gettext msgid "wp-mirror"))


;;;;--------------------------------------------------------------------------+
;;;; Libraries:                                                               |
;;;;  asdf   - process other libraries                                        |
;;;;  getopt - process command-line arguments                                 |
;;;;  md5    - compute md5sum                                                 |
;;;; Modules:                                                                 |
;;;;  clx    - provide xlib bindings                                          |
;;;;--------------------------------------------------------------------------+

;;;
;;; Design note:
;;;
;;; 1) `clisp' uses `common-lisp-controller' to load libraries.
;;;
;;; Libraries are loaded with  (clc:clc-require :foo).
;;; Modules   are loaded with  (require "foo").
;;;
;;; 2) `common-lisp-controller' expects to find `wild-modules.lisp'
;;; under `/usr/share/common-lisp/source/cl-asdf/'. However, starting
;;; with `cl-asdf' version 2.26.72, that file is found under
;;; `/usr/share/common-lisp/source/cl-asdf/contrib/'. Because
;;; `common-lisp-controller' cannot find the new location, this is a
;;; bug. So WP-MIRROR sets the symbolic link to solve the problem.
;;;

(let* ((dir-name-0     "/usr/share/common-lisp/source/cl-asdf/")
       (dir-name-1     "/usr/share/common-lisp/source/cl-asdf/contrib/")
       (dir-name       "contrib")
       (file-name      "wild-modules.lisp")
       (path-name-0    (merge-pathnames
			(parse-namestring dir-name-0)
			(parse-namestring file-name)))
       (path-name-1    (merge-pathnames
			(parse-namestring dir-name-1)
			(parse-namestring file-name)))
       (cwd            (ext:cd))
       (command-string (format nil "ln --symbolic ~a/~a ~a"
			       dir-name file-name file-name)))
  (when (null (ext:probe-pathname path-name-0))
    (if (ext:probe-pathname path-name-1)
	(prog2
	  (ext:cd dir-name-0)
	  (ext:run-shell-command command-string
				 :input nil
				 :output nil
				 :if-output-exists :overwrite)
	  (ext:cd cwd))
      (error (_ "The wild-modules.lisp file is missing.  Aborting.")))))

;;;
;;; Now load the `common-lisp-controller'
;;;

(eval-when (:compile-toplevel :execute :load-toplevel)
	   (unless (member :common-lisp-controller *features*)
	     (load #P"/usr/share/common-lisp/source/common-lisp-controller/common-lisp-controller.lisp")))

(unless (member :common-lisp-controller *features*)
  (common-lisp-controller:init-common-lisp-controller-v4 "clisp"))

;;;
;;; Design note:
;;;
;;; `common-lisp-controller' makes use of `cl-asdf' (another system
;;; definition facility). Documentation for `cl-asdf' is under
;;; `/usr/share/doc/cl-asdf/'. Look for the file `README.Debian' or a
;;; directory containing HTML pages. They should have instructions for
;;; configuring ASDF.
;;;
;;; The `asdf3' and/or `asdf2' library should have been loaded by
;;; `common-lisp-controller'.

(unless (or (member :asdf3 *features*) (member :asdf2 *features*))
  (error (_ "The :asdf3 and :asdf2 packages are missing.  Aborting.")))

;;; Now we load the remaining libraries.

(clc:clc-require :getopt)

;;; The md5 package runs far too slowly, so:
;;; o we use it only for short strings (such as file names);
;;; o we do not use it for file contents (we use shell commands instead).
(clc:clc-require :md5)

;;; Debian packages: cl-sql, cl-sql-uffi, and cl-sql-mysql all seem
;;; broken, so:
;;; o we do not use it for database access;
;;; o we use shell commands instead.

;;; Now we load the modules.

;;; The clx module is needed for the --gui option
(require "clx")


;;;;--------------------------------------------------------------------------+
;;;; Constants:                                                               |
;;;;   *author*                                                               |
;;;;   *copyright-license-and-disclaimer* (see above)                         |
;;;;   *help*                                                                 |
;;;;   *version* (see above)                                                  |
;;;;   *wtf*                                                                  |
;;;; The values of these constants are used by the build process.             |
;;;; The utility `help2man' generates the `wp-mirror.1.gz' man page out       |
;;;; of `--help' and `--version' output.  See also the functions              |
;;;; `put-help-and-die' and `put-version-and-die' below.                      |
;;;;--------------------------------------------------------------------------+


(defconstant *author*
"Written by Dr. Kent L. Miller.")


(defconstant *help*
"The Wikimedia Foundation offers Wikipedias in nearly 300 languages.
In addition, the WMF has several other projects (e.g. wikibooks,
wiktionary, etc.) for a total of around 1000 wikis.

Wp-mirror is a free utility for mirroring any desired set of these
wikis. That is, it builds a wiki farm that the user can browse
locally. Many users need such off-line access, often for reasons of
availability, mobility, and privacy. Wp-mirror builds a complete
mirror with original size media files. Wp-mirror is robust and uses
check-pointing to resume after interruption.

Wp-mirror by default mirrors the `simple wikipedia' and `simple
wiktionary' (Simple English means shorter sentences). The default
should work `out-of-the-box' with no user configuration. It should
build in 200ks (two days), occupy 150G of disk space, be served
locally by virtual hosts <http://simple.wikipedia.site/> and
<http://simple.wiktionary.site/>, and update automatically every week.
The default should be suitable for anyone who learned English as a
second language (ESL).

The top ten wikipedias are: en, de, fr, nl, it, es, pl, ru, ja, and
pt. Because wp-mirror uses original size media files, the top ten are
too large to fit on a laptop with a single 500G disk, unless the user
does not need the media files (and this is configurable). The `en
wikipedia' is the most demanding case. It should build in 1Ms (twelve
days), occupy 3T of disk space, be served locally by a virtual host
<http://en.wikipedia.site/>, and update automatically every month.

Homepage: <http://www.nongnu.org/wp-mirror/>

Usage: wp-mirror [OPTIONS] [CONFIGFILE]

Options:

  --add {<wiki>|<language-code>|<project>|all}
                     add given wiki(s) to mirror; and exit.
  --drop {<wiki>|<language-code>|<project>|all|template}
                     drop given wiki(s) from mirror; and exit.
  --help             display this help, and exit.
  --mirror [import|media|thumb|xml2sql]
                     build mirror, and exit. If `import', then process dumps
                     with `importDump.php'; if `media', then download media
                     files only; if `thumb', then generate thumbs only; if
                     `xml2sql' (default), then process XML dump files with
                     `mwxml2sql'.
  --version          display version and copyright, and exit.

Options for monitor mode:

  --gui              operate monitor in gui mode (default).
  --monitor          operate in monitor mode (gui default).
  --screen           operate monitor in screen mode.
  --text             operate monitor in text mode.

Options used during build and install:

  --copyright        display copyright file, and exit.

Options for developers:

  --debug            run in debug mode (more verbose).
  --delete {<wiki>|<language-code>|<project>|all|template}
                     delete files and state info for given wiki(s); and exit.
  --dump {<wiki>|<language-code>|<project>|all|template}
                     dump wiki database(s) to file `wiki-name.sql' in working
                     directory; and exit.  If the wiki is `template', then the
                     empty database `wikidb' will be dumped to
                     `database_farm.sql'.
  --info             display parameters, and exit.
  --profile [0|run-number]
                     for run-number a positive integer, display real-time
                     profile and disk usage stats for that mirror-building run;
                     for zero, delete all stored profile data; for no
                     run-number, display table with five most recent runs
                     compared side-by-side; and exit.
  --restore-default  drop all databases and files (except media files), and
                     start over (dangerous).
  --update {<wiki>|<language-code>|<project>|all|template}
                     update wiki database(s) to latest mediawiki schema; and
                     exit.

Files:

  /etc/apache2/sites-available/wp-mirror.site.conf  virtual host for web server

  /etc/cron.d/wp-mirror  weekly cron job

  /etc/logrotate.d/wp-mirror  logrotate configuration

  /etc/wp-mirror-mediawiki/LocalSettings_account.php  database credentials for building and using a wikipedia farm

  /etc/wp-mirror-mediawiki/LocalSettings_wpmirror.php  configuration file for building and using a wikipedia farm

  /etc/wp-mirror/default.conf  default configuration file which lists all configurable parameters (do not edit this file)

  /etc/wp-mirror/local.conf  local configuration file (edit this file instead)

  /usr/share/doc/wp-mirror/doc/wp-mirror-x.y.pdf.gz  WP-MIRROR Reference Manual

  /usr/share/wp-mirror-mediawiki/maintenance/database_farm.sql  template for wikimedia databases

  /usr/share/wp-mirror-mediawiki/maintenance/importDump_farm.php  wikipedia farm wrapper for importDump.php

  /usr/share/wp-mirror-mediawiki/maintenance/runJobs_farm.php  wikipedia farm wrapper for runJobs.php

  /usr/share/wp-mirror-mediawiki/maintenance/update_farm.php  wikipedia farm wrapper for update.php

  /usr/share/pixmaps/wp-mirror.xpm  icon for menu system

  /var/lib/wp-mirror-mediawiki/favicon.ico  favicon.ico file for browser

  /var/lib/wp-mirror-mediawiki/wp-mirror.png  WP-MIRROR logotype for browser

  /var/lib/wp-mirror-mediawiki/images/  media files are stored here

  /var/lib/wp-mirror-mediawiki/images/wp-mirror/  working files are placed here

  /var/lib/mysql/wikidb  empty wikimedia database (loaded from database_farm.sql)

  /var/lib/mysql/wpmirror  database for wp-mirror state information

  /var/lib/mysql/wiki-database  one database for each mirror in the wikipedia farm (where wiki-database stands for the name of a wiki database, such as `enwiki' or `simplewiktionary')

  /var/log/wp-mirror.log  log file

  /var/run/wp-mirror.pid  pid file

Examples:

Installation is described in the WP-MIRROR Reference Manual, usually
to be found under `/usr/share/doc/wp-mirror/doc/'. It should be
considered essential reading.

Wp-mirror uses two configuration files: `/etc/wp-mirror/default.conf'
and `/etc/wp-mirror/local.conf'. The first shows all the configurable
parameters. The second is where you should make your edits (if any).
By default, `wp-mirror' builds a mirror of the `simple' wikipedia. The
`simple' wikipedia is the collection of articles written using Simple
English. That is, the articles are written using shorter sentences, as
would be appropriate for those for whom English is a Second Language
(ESL). The `simple' wikipedia is also suitable for children. If you
wish for a different wikipedia, or a set of wikipedias's, then edit
`/etc/wp-mirror/local.conf'.

After you edit `/etc/wp-mirror/local.conf' you should run as root:

      # wp-mirror

You may run multiple instances of `wp-mirror' concurrently. The first
instance runs in mirror mode, downloading and installing the articles
and media files. Each additional instance of `wp-mirror' runs in
monitor mode. Instances running in monitor mode display the state of
each mirror. If a suitable windowing system is present, progress bars
are rendered using graphics in a separate window, and otherwise using
ASCII characters in a console. If X complains that you lack
permission, first try:

      $ xhost local:

You may control the mode of each instance of `wp-mirror' by providing
either the `--mirror' or the `--monitor' option at the command line.
For a desktop PC, it is reasonable to run two or three instances in
mirror mode together with an instance in monitor mode. However, for a
laptop PC, it is best to run just one instance in mirror mode together
with one instance in monitor mode.

Wp-mirror normally runs in background as a weekly cron job, updating
the mirrors whenever the Wikimedia Foundation posts new dump files.

Wp-mirror configures a virtual-host for your web-server in
`/etc/apache2/enabled/wp-mirror.site.conf'. Wp-mirror adds the
following lines to `/etc/hosts':

      ::1 simple.wikipedia.site

      ::1 simple.wiktionary.site

Then just open a web browser to <http://simple.wikipedia.site/> and
enjoy.

Report bugs in `wp-mirror' to <wp-mirror-list@nongnu.org>.")


;;;;--------------------------------------------------------------------------+
;;;; Any number of mirrors and monitors can communicate state via database    |
;;;;                                                                          |
;;;;     +--------+                      +---------+                          |
;;;;     | mirror |------          ------| monitor |                          |
;;;;     +--------+      \        /      +---------+                          |
;;;;     +--------+     +----------+                                          |
;;;;     | mirror |-----| wpmirror |                                          |
;;;;     +--------+     +----------+                                          |
;;;;     +--------+      /        \      +---------+                          |
;;;;     | mirror |------          ------| monitor |                          |
;;;;     +--------+                      +---------+                          |
;;;;                                                                          |
;;;;--------------------------------------------------------------------------+


(defconstant *wtf*
  "For help, please try:
    $ wp-mirror --help")


;;;;--------------------------------------------------------------------------+
;;;; Print utilities:                                                         |
;;;;   The idea is to give all the messages a common look and feel, and to    |
;;;;   have few format strings outside of this section.                       |
;;;;   Note:  `put-and-log-string' should be the only way to *standard-output*|
;;;;--------------------------------------------------------------------------+


(defun put-and-log-string (str &key (put nil))
  "Showing given string, and copying it to log file (if any)."
  (unless (null put)
    (format *standard-output* "~a~%" str))
  (unless (null *log-enabled-p*)
    (with-open-file (f *whereis-file-wpmirror-log*
		       :direction :output
		       :if-exists :append
		       :if-does-not-exist :create)
      (format f "[~d]~a~%" (os:process-id) str))))

(defun die ()
  "Exiting immediately."
  (ext:exit 0))

(defun abort-and-die (&key (put nil))
  "Showing abort message, and die."
  (put-and-log-string (format nil "~a." (_ "Aborting")) :put put)
  (die))

(defun debug-message (message &key (put t))
  "Showing given message when non-zero debug-level."
  (when (>= *debug-level* 1)
    (put-message (format nil "~a~a" (_ ";debug: ") message) :put nil)))

(defun debug-message-done (message &key (put t))
  "Showing given message followed by [DONE] when non-zero debug-level."
  (when (>= *debug-level* 1)
    (put-message-done (format nil "~a~a" (_ ";debug: ") message) :put nil)))

(defun debug-message-start (message &key (put t))
  "Showing given message followed by ellipses when non-zero debug-level."
  (when (>= *debug-level* 1)
    (put-message-start (format nil "~a~a" (_ ";debug: ") message) :put nil)))

(defun debug-message-value (message value &key (put nil))
  "Showing given message and value when non-zero debug-level."
  (when (>= *debug-level* 1)
    (put-message-value (format nil "~a~a" (_ ";debug: ") message) value
		       :put nil)))

(defun format-integer-for-human (n)
  "Formatting a number for human (e.g. 4096 --> 4.1K).  
Return four character string."
  (cond ((<= n 999)             (format nil "~3d " n))
	((<= n 9949)            (format nil "~3,1,-3fK" n))
	((<= n 999499)          (format nil "~3dK" (round (/ n 1000))))
	((<= n 9949999)         (format nil "~3,1,-6fM" n))
	((<= n 999499999)       (format nil "~3dM" (round (/ n 1000000))))
	((<= n 9949999999)      (format nil "~3,1,-9fG" n))
	((<= n 999499999999)    (format nil "~3dG" (round (/ n 1000000000))))
	((<= n 9949999999999)   (format nil "~3,1,-9fT" n))
	((<= n 999499999999999) 
	 (format nil "~3dT" (round (/ n 1000000000000))))
	((<= n 9949999999999999)   
	 (format nil "~3,1,-9fP" n))
	((<= n 999499999999999999)
	 (format nil "~3dP" (round (/ n 1000000000000000))))
	((<= n 9949999999999999999)   
	 (format nil "~3,1,-12fE" n))
	((<= n 999499999999999999999)
	 (format nil "~3dE" (round (/ n 1000000000000000000))))
	((<= n 9949999999999999999999)   
	 (format nil "~3,1,-15fZ" n))
	((<= n 999499999999999999999999)
	 (format nil "~3dZ" (round (/ n 1000000000000000000000))))
	((<= n 9949999999999999999999999)   
	 (format nil "~3,1,-18fY" n))
	((<= n 999499999999999999999999999)
	 (format nil "~3dY" (round (/ n 1000000000000000000000000))))
	(t                      (format nil "~d" n))))

(defun format-progress-bar-pulse ()
  "Formatting a progress bar (pulse type) as a string"
  (format-progress-bar-string 0.5 :pulse t))

(defun value-within-bound (lower-bound trial-value upper-bound)
  "Imposing bounds upon value"
  (max lower-bound (min trial-value upper-bound)))

(defun format-progress-bar-string (val &key (pulse nil))
  "Formatting a progress bar as a string"
  (let* ((len-string        35)
	 (s                 (make-string len-string :initial-element #\Space))
	 ;; if pulse, then use clock to generate pulse motion
	 (val-float         (cond (pulse (float (/ (get-decoded-time) 60)))
				  ((null val) 0)
				  ((numberp val) 
				   (value-within-bound 0 val 1))  ; [0,1]
				  (t val)))
	 (val-percent       (* val-float 100))
	 (val-chars         (floor (* val-float len-string)))
	 (pos-equal-left    0)
	 (pos-arrow         (1- (+ pos-equal-left val-chars)))
	 (pos-equal-right   (1- pos-arrow)))
    (when (>= pos-arrow 0)
      (loop 
	for i of-type integer from pos-equal-left to pos-equal-right by 1
	do (setf (aref s i) #\=))
      (setf (aref s pos-arrow) #\>))
    (cond (pulse               (format nil "[~a] pulse" s))
          ((= val-percent   0) (format nil "[~a] wait " s))
          ((= val-percent 100) (format nil "[~a] done " s))
          (t                   (format nil "[~a] ~5,2f%" s val-percent)))))

(defun put-message (message &key (put nil))
  "Showing given message"
  (put-and-log-string (format nil "~a" message) :put put))

(defun put-message-and-abort (message &key (put t))
  "Showing given message, and abort."
  (put-message message :put put)
  (abort-and-die))

(defun put-message-and-die (message &key (put nil))
  "Showing given message, and die."
  (put-message message :put put)
  (die))

(defun put-message-done (message &key (put nil))
  "Showing given message followed by [DONE]."
  (put-message-result message :DONE :put put))

(defun put-message-done-2 (message &key (put nil))
  "Showing given message followed by [DONE]."
  (put-message-result message :DONE :put put)
  (put-flag-message :info (_ "done")))

(defun put-message-fail (message &key (put t))
  "Showing given message followed by [FAIL]."
  (put-message-result message :FAIL :put put))

(defun put-message-fail-2 (message &key (put t))
  "Showing given message followed by [FAIL]."
  (put-message-result message :FAIL :put put)
  (put-flag-message :info (_ "fail")))

(defun put-message-fail-and-abort (message &key (put t))
  "Showing given message followed by [FAIL], and abort."
  (put-message-result message :FAIL :put put)
  (abort-and-die))

(defun put-message-fail-and-die (message &key (put t))
  "Showing given message followed by [FAIL], and die."
  (put-message-result message :FAIL :put put)
  (die))

(defun put-message-pass (message &key (put nil))
  "Showing given message followed by [PASS]."
  (put-message-result message :PASS :put put))

(defun put-message-result (message result &key (put nil))
  "Showing given message followed by a result"
  (put-and-log-string (format nil "~70a[~a]" message result) :put put))

(defun put-message-start (message &key (put nil))
  "Showing given message followed by ellipses."
  (put-and-log-string (format nil "~a ..." message) :put put))

(defun put-message-value (message value &key (put nil))
  "Showing given message and a value."
  (put-and-log-string (format nil "~34a: ~a" message value) :put put))

(defun put-message-value-done (message value &key (put nil))
  "Showing given message and value, followed by [DONE]."
  (put-message-value-result message value :DONE :put put))

(defun put-message-value-done-2 (message value &key (put nil))
  "Showing given message and value, followed by [DONE]."
  (put-message-value-result message value :DONE :put put)
  (put-flag-message :info (_ "done")))

(defun put-message-value-fail (message value &key (put t))
  "Showing given message and value, followed by [FAIL]."
  (put-message-value-result message value :FAIL :put put))

(defun put-message-value-fail-2 (message value &key (put t))
  "Showing given message and value, followed by [FAIL]."
  (put-message-value-result message value :FAIL :put put)
  (put-flag-message :info (_ "fail")))

(defun put-message-value-fail-and-abort (message value &key (put t))
  "Showing given message and value, followed by [FAIL], and abort."
  (put-message-value-result message value :FAIL :put put)
  (abort-and-die))

(defun put-message-value-fail-and-die (message value &key (put t))
  "Showing given message and value, followed by [FAIL], and die."
  (put-message-value-result message value :FAIL :put put)
  (die))

(defun put-message-value-pass (message value &key (put nil))
  "Showing given message and value, followed by [PASS]."
  (put-message-value-result message value :PASS :put put))

(defun put-message-value-result (message value result &key (put nil))
  "Showing given message and value, followed by a result"
  (put-and-log-string (format nil "~34a: ~34a[~a]" message value result)
		      :put put))

(defun put-symbol-value (symbol &key (put nil))
  "Showing symbol and its value."
  (put-and-log-string (format nil "~34s: ~a" symbol (symbol-value symbol)) 
		      :put put))

(defun put-symbol-value-fail (symbol &key (put nil))
  "Showing symbol, its value, and [FAIL]."
  (put-symbol-value-result symbol :FAIL :put put))

(defun put-symbol-value-pass (symbol &key (put nil))
  "Showing symbol, its value, and [PASS]."
  (put-symbol-value-result symbol :PASS :put put))

(defun put-symbol-value-result (symbol result &key (put nil))
  "Showing symbol, its value, and a result."
  (put-and-log-string (format nil "~34s: ~34a[~a]" 
			      symbol (symbol-value symbol) result)
		      :put put))

(defun put-symbol-value-table (symbol-list &key (put nil))
  "Showing table of symbols and their values."
  (dolist (symbol symbol-list t)
    (put-symbol-value symbol :put put)))


;;;;--------------------------------------------------------------------------+
;;;; Parameters:                                                              |
;;;;   May be changed by: 1) config file `/etc/wp-mirror/local.conf', or      |
;;;;                      2) by command-line options.                         |
;;;;--------------------------------------------------------------------------+

;;; Was `--mirror' given as command line options?
(defparameter *cmd-force-mirror*        nil)
;;; Were any of `--gui', `--monitor', `--screen', or `--text' 
;;; given as command line options?
(defparameter *cmd-force-monitor*       nil)

;;;
;;; Design note:
;;;
;;; 0) WP-MIRROR when first installed has no database credentials.
;;;
;;; 1) WP-MIRROR, therefore, first scrapes `debian-sys-maint'
;;; credentials from `/etc/mysql/debian.cnf'.  WP-MIRROR can now
;;; access the DBMS with ALL PRIVILEGES.
;;; 
;;; 2) WP-MIRROR generates the passwords for `wikiadmin' and
;;; `wikiuser', and writes them to
;;; `/etc/wp-mirror-mediawiki/LocalSettings_account.php'.
;;;
;;; 3) WP-MIRROR accesses the DBMS to create accounts and grant 
;;; privileges to `wikiadmin' and `wikiuser'.
;;;    a) `wikiadmin' is granted ALL PRIVILEGES with WP-MIRROR related
;;;       databases (e.g. `wikidb', `simplewiki', and `wpmirror').
;;;    b) `wikiuser' is granted SELECT, INSERT, UPDATE, and
;;;       DELETE privileges with WP-MIRROR related databases.
;;;
;;; 4) Thereafter, both WP-MIRROR and MediaWiki obtain `wikiadmin' and
;;; `wikiuser' credentials by scraping:
;;; `/etc/wp-mirror-mediawiki/LocalSettings_account.php'.
;;;
(defparameter *db-debian-user*          nil)         ; expect `debian-sys-maint'
(defparameter *db-debian-password*      nil)         ;
(defparameter *db-root-user*            "root")      ; expect `root'
(defparameter *db-root-password*        nil)         ;
(defparameter *db-wikiadmin-user*       "wikiadmin") ; expect `wikiadmin'
(defparameter *db-wikiadmin-password*   nil)         ;
(defparameter *db-wikiuser-user*        "wikiuser")  ; expect `wikiuser'
(defparameter *db-wikiuser-password*    nil)         ; 
(defparameter *db-name*                 "wikidb")
(defparameter *db-server*               "localhost")  
(defparameter *db-type*                 "mysql")      
(defparameter *db-wpmirror-name*        "wpmirror")   
(defparameter *db-wpmirror-tables*      '("file" "priority" "time"))
(defparameter *db-wpmirror-profile*     0)           ; run number of profile

(defparameter *debug-level*             0)
(defparameter *log-enabled-p*           nil)

;;; Main modes (:add :delete :drop :dump :info :first-mirror :next-mirror
;;;             :monitor :profile :restore-default :update)
(defparameter *main-mode*               nil)
(defparameter *main-run*                nil)
(defparameter *main-wiki*               nil)

;; MediaWiki configuration
(defparameter *mediawiki-config-localsettings-account-lines* 6)
(defparameter *mediawiki-php-xdebug-max-nesting-level*  200)
(defparameter *mediawiki-version*                    "1.24")
(defparameter *mediawiki-wgUseImageMagick*           "true")
(defparameter *mediawiki-wgCustomConvertCommand*    "false")
(defparameter *mediawiki-wgSVGConverter*      "ImageMagick")
;;(defparameter *mediawiki-wgUseImageMagick*          "false") ; "true"
;;(defparameter *mediawiki-wgCustomConvertCommand*
;;  "/usr/bin/gm convert %s -resize %wx%h %d")
;;(defparameter *mediawiki-wgSVGConverter*         "inkscape") ; "rsvg"

;;; Concurrency of mirroring

;;; Do we download and validate image files?  
(defparameter *mirror-commons*                    "commons")
(defparameter *mirror-commonswiki*            "commonswiki")
(defparameter *mirror-dchunk-page-count*                 10)
(defparameter *mirror-delete-superseded-revisions*      nil)
(defparameter *mirror-download-connection-time-max*   10000)
(defparameter *mirror-host-name-elasticsearch*  "localhost")
(defparameter *mirror-image-download-p*                   t)
(defparameter *mirror-innodb-fast-index-creation*         t)
(defparameter *mirror-innodb-table-key-block-size-list*
  ;; table-key = (table-name key-block-size key-drop-p key-keep-list)
  ;; table-name        key-block-size key-drop-p key-keep-list
  '(("categorylinks"   4              t          ("cl_from"))    ; added primary
    ("externallinks"   4              t          nil)
    ("image"           4              t          nil)
    ("imagelinks"      4              t          ("il_from"))    ; added primary
    ("langlinks"       4              t          ("ll_from"))    ; added primary
    ("page"            4              t          ("name_title"))
    ("pagelinks"       4              t          ("pl_from"))    ; added primary
    ("revision"        4              t          nil)
    ("templatelinks"   4              t          ("tl_from"))    ; added primary
    ("text"            4              t          nil)
    ("titlekey"        4              t          nil)
    ("wb_entity_per_page" 4           t          ("wb_epp_entity"))
    ("wb_items_per_site"  4           t          ("wb_ips_item_site_page"))
    ("wb_terms"        4              t          nil)
    ))
(defparameter *mirror-language-code-list*       '("simple"))
(defparameter *mirror-objectcache-delete-limit*        1000)
(defparameter *mirror-objectcache-threshold*          10000)
;; *mirror-process-xml* is one of (:import :media :thumb :xml2sql)
(defparameter *mirror-process-xml*                 :xml2sql)
(defparameter *mirror-profiles-max*                       5)
(defparameter *mirror-project-list*             '("wikipedia" "wiktionary"))
(defparameter *mirror-schunk-page-count*                 10)
(defparameter *mirror-sleep-list*                            ; 100444 sec
  '(1 3 10 30 100 300 1000 3000 3000 3000
    3000 3000 3000 3000 3000   3000 3000 3000 3000 3000
    3000 3000 3000 3000 3000   3000 3000 3000 3000 3000
    3000 3000 3000 3000 3000   3000 3000 3000 3000 3000))
(defparameter *mirror-sleep-timeout-sec-max*         100000)
(defparameter *mirror-split-sql*                    :schunk) ;(:dchunk,:schunk)
(defparameter *mirror-timeout-sec-importdump*           200)
(defparameter *mirror-virtual-host-name*   "wp-mirror.site")
(defparameter *mirror-wiki-list*                        nil) ; set later
(defparameter *mirror-wikidata*                  "wikidata")
(defparameter *mirror-wikidatawiki*          "wikidatawiki")
(defparameter *mirror-xchunk-concurrency-limit*           1) ; [1-3]
(defparameter *mirror-xchunk-page-count*               2000)
(defparameter *mirror-xchunk-page-count-min*            200)
(defparameter *mirror-xchunk-page-count-max*          20000)
(defparameter *mirror-xdump-download-p*                   t)

;;; Monitors (if any) should poll mirror status every so many seconds.
(defparameter *monitor-gui-font-preference-list* ; most preferred first
  '("-*-helvetica-medium-r-*-*-12-*-*-*-*-*-*"
    "-*-lucida-medium-r-*-*-12-*-*-*-*-*-*"
    "-*-lucida-medium-r-*-*-14-*-*-*-*-*-*"))
(defparameter *monitor-mode*          :auto)    ; (:auto, :gui, :screen, :text)
(defparameter *monitor-poll-sec*         10)
(defparameter *monitor-poll-sec-min*      1)
(defparameter *monitor-poll-sec-max*    100)
(defparameter *monitor-screen-stream*   nil)    ; if choose :screen
(defparameter *monitor-screen-height*   nil)    ; if choose :screen
(defparameter *monitor-screen-width*    nil)    ; if choose :screen

;;; Constants
(defconstant *kibibyte*        (expt 1024 1) "KiB")
(defconstant *mebibyte*        (expt 1024 2) "MiB")
(defconstant *gibibyte*        (expt 1024 3) "GiB")
(defconstant *tebibyte*        (expt 1024 4) "TiB")
(defconstant *kibobyte*        (expt 1000 1) "K or KB")
(defconstant *megabyte*        (expt 1000 2) "M or MB")
(defconstant *gigabyte*        (expt 1000 3) "G or GB")
(defconstant *terabyte*        (expt 1000 4) "T or TB")

;;; System resources minimums
(defparameter *system-cpu*                       1)
(defparameter *system-cpu-min*                   1)
(defparameter *system-cpu-max*                   3)
(defparameter *system-hdd-name-list*           nil)
(defparameter *system-hdd-write-cache*           1)   ; 0=disabled, 1=enabled
(defparameter *system-hdd-write-cache-flush*   nil)   ; t=flush at checkpoint
(defparameter *system-hdd-identification-p*    nil)
;;; Assert adequate disk and memory capacity for largest wiki's
(defparameter *system-partition-free-images-start-min* (* 200 *gigabyte*))
(defparameter *system-partition-free-images-warn*      (* 100 *gigabyte*))
(defparameter *system-partition-free-images-min*       (*  50 *gigabyte*))
(defparameter *system-partition-free-innodb-min*       (*  30 *gigabyte*))
(defparameter *system-physical-memory-min*             (*   4 *gigabyte*))
(defparameter *wikimedia-large-language-code-list*
  '("en" "de" "fr" "nl" "it" "ru" "es" "sv" "pl" "ja"))

;;; Most of the heavy lifting is done by invoking existing utilities.
(defparameter *whereis-apache2*             "/etc/init.d/apache2")
(defparameter *whereis-apache2ctl*          "/usr/sbin/apache2ctl")
(defparameter *whereis-bashrc*              "/etc/bash.bashrc")
(defparameter *whereis-bunzip2*             "/bin/bunzip2")
(defparameter *whereis-bzcat*               "/bin/bzcat")
(defparameter *whereis-bzip2*               "/bin/bzip2")
(defparameter *whereis-cat*                 "/bin/cat")
(defparameter *whereis-chmod*               "/bin/chmod")
(defparameter *whereis-chown*               "/bin/chown")
(defparameter *whereis-convert*             "/usr/bin/convert")
(defparameter *whereis-cp*                  "/bin/cp")
(defparameter *whereis-curl*                "/usr/bin/curl")
(defparameter *whereis-curlrc*              "/root/.curlrc")
;;; Need directories
(defparameter *whereis-directory-apache-sites-available*
  "/etc/apache2/sites-available/")
(defparameter *whereis-directory-apache-sites-enabled*
  "/etc/apache2/sites-enabled/")
(defparameter *whereis-directory-cron*
  "/etc/cron.d/")
(defparameter *whereis-directory-mediawiki*
  "/var/lib/wp-mirror-mediawiki/")
(defparameter *whereis-directory-mediawiki-cache*
  "/var/lib/wp-mirror-mediawiki/cache/")
(defparameter *whereis-directory-mediawiki-config*
  "/etc/wp-mirror-mediawiki/")
(defparameter *whereis-directory-mediawiki-extensions-cirrussearch-maintenance*
  "/var/lib/wp-mirror-mediawiki/extensions/CirrusSearch/maintenance/")
(defparameter *whereis-directory-mediawiki-extensions-localisation-update*
  "/var/lib/wp-mirror-mediawiki/extensions/LocalisationUpdate/")
(defparameter *whereis-directory-mediawiki-extensions-math-math*
  "/var/lib/wp-mirror-mediawiki/extensions/Math/math/")
(defparameter *whereis-directory-mediawiki-extensions-math-texvccheck*
  "/var/lib/wp-mirror-mediawiki/extensions/Math/texvccheck/")
(defparameter *whereis-directory-mediawiki-extensions-titlekey*
  "/var/lib/wp-mirror-mediawiki/extensions/TitleKey/")
(defparameter *whereis-directory-mediawiki-images*
  "/var/lib/wp-mirror-mediawiki/images/")
(defparameter *whereis-directory-mediawiki-images-old*
  "/var/lib/mediawiki/images/")
(defparameter *whereis-directory-mediawiki-licenses*
  "/usr/share/wp-mirror-mediawiki/resources/assets/licenses/")
(defparameter *whereis-directory-mediawiki-maintenance*
  "/usr/share/wp-mirror-mediawiki/maintenance/")
(defparameter *whereis-directory-mysql-config*            "/etc/mysql/")
(defparameter *whereis-directory-mysql-config-conf.d*     "/etc/mysql/conf.d/")
(defparameter *whereis-directory-mysql-datadir*           "/var/lib/mysql/")
(defparameter *whereis-directory-php-mods-available*
  "/etc/php5/mods-available/")
(defparameter *whereis-directory-tmp*                     "/tmp/")
(defparameter *whereis-directory-wpmirror-config*         "/etc/wp-mirror/")
(defparameter *whereis-directory-wpmirror-restore*
  "/usr/share/doc/wp-mirror/restore/")
(defparameter *whereis-directory-wpmirror-working*
  "/var/lib/wp-mirror-mediawiki/images/wp-mirror/")
(defparameter *whereis-directory-www*                     "/var/www/")
(defparameter *whereis-du*                                "/usr/bin/du")
(defparameter *whereis-echo*                              "/bin/echo")
(defparameter *whereis-env*                               "/usr/bin/env")
;;; Need files
(defparameter *whereis-file-cron*                         "wp-mirror")
(defparameter *whereis-file-dev-null*                     "/dev/null")
(defparameter *whereis-file-etc-hosts*                    "/etc/hosts")
(defparameter *whereis-file-mediawiki-cache-interwiki-cdb* "interwiki.cdb")
(defparameter *whereis-file-mediawiki-config-all-dblist*  "all.dblist")
(defparameter *whereis-file-mediawiki-config-initialisesettings*
  "InitialiseSettings.php")
(defparameter *whereis-file-mediawiki-config-localsettings* "LocalSettings.php")
(defparameter *whereis-file-mediawiki-config-localsettings-account*
  "LocalSettings_account.php")
(defparameter *whereis-file-mediawiki-config-localsettings-wpmirror*
  "LocalSettings_wpmirror.php")
(defparameter *whereis-file-mediawiki-extensions-cirrussearch-forcesearchindex*
  "forceSearchIndex_farm.php")
(defparameter
  *whereis-file-mediawiki-extensions-cirrussearch-updatesearchindexconfig*
  "updateSearchIndexConfig_farm.php")
(defparameter *whereis-file-mediawiki-extensions-localisation-update*
  "localisationUpdate_farm.php")
(defparameter *whereis-file-mediawiki-extensions-titlekey-rebuild-titlekey*
  "rebuildTitleKeys_farm.php")
(defparameter *whereis-file-mediawiki-farm-database*      "database_farm.sql")
(defparameter *whereis-file-mediawiki-farm-importdump*    "importDump_farm.php")
(defparameter *whereis-file-mediawiki-farm-runjobs*       "runJobs_farm.php")
(defparameter *whereis-file-mediawiki-farm-update*        "update_farm.php")
(defparameter *whereis-file-mediawiki-favicon*            "favicon.ico")
(defparameter *whereis-file-mediawiki-logo*               "wp-mirror.png")
(defparameter *whereis-file-mediawiki-rights*             "somerights20.png")
(defparameter *whereis-file-mediawiki-update*             "update.php")
(defparameter *whereis-file-mysql-config-debian*          "debian.cnf")
(defparameter *whereis-file-mysql-config-wpmirror*        "wp-mirror.cnf")
(defparameter *whereis-file-mysql-log-file*               "ib_logfile*")
(defparameter *whereis-file-php-xdebug*                   "xdebug.ini")
(defparameter *whereis-file-symbolic-link-to-mediawiki*   "w")
(defparameter *whereis-file-tmp-http*                     "/tmp/http")
(defparameter *whereis-file-virtual-host*           "wp-mirror.site.conf")
(defparameter *whereis-file-wpmirror-config-default*      "default.conf")
(defparameter *whereis-file-wpmirror-config-local*        "local.conf")
(defparameter *whereis-file-wpmirror-log*           "/var/log/wp-mirror.log")
(defparameter *whereis-file-wpmirror-pid*           "/var/run/wp-mirror.pid")
(defparameter *whereis-gawk*                "/usr/bin/gawk")
(defparameter *whereis-gm*                  "/usr/bin/gm")
(defparameter *whereis-grep*                "/bin/grep")
(defparameter *whereis-gunzip*              "/bin/gunzip")
(defparameter *whereis-gzip*                "/bin/gzip")
(defparameter *whereis-hdparm*              "/sbin/hdparm")
(defparameter *whereis-identify*            "/usr/bin/identify")
(defparameter *whereis-inkscape*            "/usr/bin/inkscape")
(defparameter *whereis-invoke-rc.d*         "/usr/sbin/invoke-rc.d")
(defparameter *whereis-ls*                  "/bin/ls")
(defparameter *whereis-lua*                 "/usr/bin/lua5.1")
(defparameter *whereis-md5sum*              "/usr/bin/md5sum")
(defparameter *whereis-mv*                  "/bin/mv")
(defparameter *whereis-mwxml2sql*           "/usr/bin/mwxml2sql")
(defparameter *whereis-mysql*               "/usr/bin/mysql")
(defparameter *whereis-mysqladmin*          "/usr/bin/mysqladmin")
(defparameter *whereis-mysqldump*           "/usr/bin/mysqldump")
(defparameter *whereis-mysql-install-db*    "/usr/bin/mysql_install_db")
(defparameter *whereis-mysql-tzinfo-to-sql* "/usr/bin/mysql_tzinfo_to_sql")
(defparameter *whereis-openssl*             "/usr/bin/openssl")
(defparameter *whereis-php*                 "/usr/bin/php")
(defparameter *whereis-ping*                "/bin/ping")
(defparameter *whereis-ping6*               "/bin/ping6")
(defparameter *whereis-replace*             "/usr/bin/replace")
(defparameter *whereis-rm*                  "/bin/rm")
(defparameter *whereis-rsvg*                "/usr/bin/rsvg")
(defparameter *whereis-rsync*               "/usr/bin/rsync")
(defparameter *whereis-split*               "/usr/bin/split")
(defparameter *whereis-tar*                 "/bin/tar")
(defparameter *whereis-texvc*               "/usr/bin/wp-mirror-texvc")
(defparameter *whereis-texvccheck*          "/usr/bin/wp-mirror-texvccheck")
(defparameter *whereis-timeout*             "/usr/bin/timeout")
(defparameter *whereis-wc*                  "/usr/bin/wc")
(defparameter *whereis-wget*                "/usr/bin/wget")
(defparameter *whereis-wgetrc*              "/etc/wgetrc")
(defparameter *whereis-x*                   "/usr/bin/X")
(defparameter *whereis-zcat*                "/bin/zcat")
(defparameter *whereis-zgrep*               "/bin/zgrep")
(defparameter *whereis-zoneinfo*            "/usr/share/zoneinfo")

;;; paths to files that can be restored
(defparameter *wpmirror-config-restore-list*
  '((*whereis-directory-cron*             *whereis-file-cron*)
    (*whereis-directory-mysql-config-conf.d*
     *whereis-file-mysql-config-wpmirror*)
    (*whereis-directory-wpmirror-config*
     *whereis-file-wpmirror-config-default*)
    (*whereis-directory-wpmirror-config*  *whereis-file-wpmirror-config-local*)
    (*whereis-directory-mediawiki-cache*
     *whereis-file-mediawiki-cache-interwiki-cdb*)
    (*whereis-directory-mediawiki-config*
     *whereis-file-mediawiki-config-all-dblist*)
    (*whereis-directory-mediawiki-config*
     *whereis-file-mediawiki-config-initialisesettings*)
    (*whereis-directory-mediawiki-config*
     *whereis-file-mediawiki-config-localsettings*)
    (*whereis-directory-mediawiki-config*
     *whereis-file-mediawiki-config-localsettings-account*)
    (*whereis-directory-mediawiki-config*
     *whereis-file-mediawiki-config-localsettings-wpmirror*)
    (*whereis-directory-mediawiki-extensions-cirrussearch-maintenance*
     *whereis-file-mediawiki-extensions-cirrussearch-forcesearchindex*)
    (*whereis-directory-mediawiki-extensions-cirrussearch-maintenance*
     *whereis-file-mediawiki-extensions-cirrussearch-updatesearchindexconfig*)
    (*whereis-directory-mediawiki-extensions-localisation-update*
     *whereis-file-mediawiki-extensions-localisation-update*)
    (*whereis-directory-mediawiki-extensions-titlekey*
     *whereis-file-mediawiki-extensions-titlekey-rebuild-titlekey*)
    (*whereis-directory-mediawiki-maintenance*
     *whereis-file-mediawiki-farm-database*)
    (*whereis-directory-mediawiki-maintenance*
     *whereis-file-mediawiki-farm-importdump*)
    (*whereis-directory-mediawiki-maintenance*
     *whereis-file-mediawiki-farm-runjobs*)
    (*whereis-directory-mediawiki-maintenance*
     *whereis-file-mediawiki-farm-update*)
    (*whereis-directory-mediawiki*        *whereis-file-mediawiki-favicon*)
    (*whereis-directory-mediawiki*        *whereis-file-mediawiki-logo*)
    (*whereis-directory-mediawiki-licenses*
     *whereis-file-mediawiki-rights*)
    ))

;;; links to binaries from MediaWiki extensions
(defparameter *mediawiki-extension-link-list*
  '((*whereis-texvc*
     *whereis-directory-mediawiki-extensions-math-math*
     "texvc")
    (*whereis-texvccheck*
     *whereis-directory-mediawiki-extensions-math-texvccheck*
     "texvccheck")
    ))

;;; templates for wikimedia dump files
;;    `xxwiki'   - name of a wiki
;;    `yyyymmdd' - date of dump file
;;    `zz'       - `local' or `remote'
;;    `nn'       - integer
(defparameter *wikimedia-path-checksums-template*
  "xxwiki/yyyymmdd/xxwiki-yyyymmdd-md5sums.txt")
(defparameter *wikimedia-path-idump-template*
  "fulls/yyyymmdd/xxwiki-yyyymmdd-zz-media-nn.tar")
(defparameter *wikimedia-path-sdump-template-import-list*
  '("xxwiki/yyyymmdd/xxwiki-yyyymmdd-image.sql.gz"
    ))
(defparameter *wikimedia-path-sdump-template-xml2sql-list*
  '("xxwiki/yyyymmdd/xxwiki-yyyymmdd-category.sql.gz"
    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-categorylinks.sql.gz"
    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-externallinks.sql.gz"
    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-image.sql.gz"
    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-imagelinks.sql.gz"
;;    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-interwiki.sql.gz"
    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-iwlinks.sql.gz"
    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-langlinks.sql.gz"
    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-page_props.sql.gz"
    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-page_restrictions.sql.gz"
    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-pagelinks.sql.gz"
    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-protected_titles.sql.gz"
    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-redirect.sql.gz"
    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-site_stats.sql.gz"
    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-templatelinks.sql.gz"
    ))
(defparameter *wikimedia-path-sdump-template-wikidata-list*
  '("xxwiki/yyyymmdd/xxwiki-yyyymmdd-sites.sql.gz"
    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-wb_entity_per_page.sql.gz"
    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-wb_items_per_site.sql.gz"
    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-wb_terms.sql.gz"
    ))
(defparameter *wikimedia-xdump-type*      :current)
(defparameter *wikimedia-xdump-type-list*
  '(:articles :current)) ; :history is not yet implemented
(defparameter *wikimedia-xdump-type-string-list*
  '("articles" "meta-current" "meta-history"))

(defun wikimedia-path-sdump-template-list (wiki &key (put nil))
  "Selecting `sdump' path templates"
  (let ((result (case *mirror-process-xml*
		      (:import   *wikimedia-path-sdump-template-import-list*)
		      (:thumb    *wikimedia-path-sdump-template-import-list*)
		      (:xml2sql  *wikimedia-path-sdump-template-xml2sql-list*))
		))
    (when (string= wiki "wikidatawiki")
      (setq result
	    (append result *wikimedia-path-sdump-template-wikidata-list*)))
    result))

(defun wikimedia-path-xdump-template-list (&key (put nil))
  "Selecting `xdump' path templates corresponding to `xdump' type"
  (let ((result nil))
    (when (eq *mirror-process-xml* :xml2sql)
      (push
       (case *wikimedia-xdump-type*
	     (:articles
	      "xxwiki/yyyymmdd/xxwiki-yyyymmdd-stub-articles.xml.gz")
	     (:current
	      "xxwiki/yyyymmdd/xxwiki-yyyymmdd-stub-meta-current.xml.gz")
	     (:history
	      "xxwiki/yyyymmdd/xxwiki-yyyymmdd-stub-meta-history.xml.gz"))
       result))
    (push
     (case *wikimedia-xdump-type*
	   (:articles
	    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-pages-articles.xml.bz2")
	   (:current
	    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-pages-meta-current.xml.bz2")
	   (:history
	    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-pages-meta-history.xml.bz2"))
     result)
    result))

(defun wikimedia-path-dump-template-list (wiki &key (put nil))
  "Selecting `sdump' and `xdump' path templates for given wiki"
  (append (wikimedia-path-sdump-template-list wiki :put put)
	  (wikimedia-path-xdump-template-list :put put)))

(defun wikimedia-xdump-type-string (&key (put nil))
  "Selecting `xdump' string corresponding to `xdump' type"
  (loop
   for xdump-type        in *wikimedia-xdump-type-list*
   as  xdump-type-string in *wikimedia-xdump-type-string-list*
   when (eq xdump-type *wikimedia-xdump-type*)
   return xdump-type-string
   finally (put-message-value-fail-and-abort (_ "unknown xdump type")
					     *wikimedia-xdump-type*)))

(defparameter *wikimedia-path-xincr-template-list*
  '("xxwiki/yyyymmdd/xxwiki-yyyymmdd-pages-meta-hist-incr.xml.bz2"
    "xxwiki/yyyymmdd/xxwiki-yyyymmdd-stubs-meta-hist-incr.xml.gz"
    ))

(defun wikimedia-path-xincr-template-list (&key (put nil))
  "Selecting `xincr' path templates"
  *wikimedia-path-xincr-template-list*)

;; URLs for wikimedia media dumps
(defparameter *wikimedia-site-idump*      nil)
(defparameter *wikimedia-site-idump-fallback-list*
  '("http://darkstar-5/wikimedia/imagedumps/tarballs/"  ; test site
    "http://ftpmirror.your.org/pub/wikimedia/imagedumps/tarballs/"
    ))
(defparameter *wikimedia-site-idump-list*
  '(;; your.org                                         ; nothing after 2012
    "rsync://ftpmirror.your.org/wikimedia-imagedumps/tarballs/"
    "ftp://ftpmirror.your.org/pub/wikimedia/imagedumps/tarballs/"
    "http://ftpmirror.your.org/pub/wikimedia/imagedumps/tarballs/"
    ))
;; URLs for wikimedia media files
(defparameter *wikimedia-site-image*      nil)
(defparameter *wikimedia-site-image-fallback-list*
  '("http://upload.wikimedia.org/"
    ))
(defparameter *wikimedia-site-image-list*
  '("http://upload.wikimedia.org/"                      ; <-- default
    ;; your.org                                         ; nothing after 2012
    "http://ftpmirror.your.org/pub/wikimedia/images/"
    "ftp://ftpmirror.your.org/pub/wikimedia/images/"
    "rsync://ftpmirror.your.org/wikimedia-images/"
    ))
;; URLs for wikimedia XML dump files
(defparameter *wikimedia-site-xdump*      nil)
(defparameter *wikimedia-site-xdump-dirlist*
  "rsync-dirlist-last-1-good.txt"
  )
(defparameter *wikimedia-site-xdump-fallback-list*
  '("http://darkstar-5/wikimedia/"                      ; test site
    "http://dumps.wikimedia.your.org/"
    "http://wikipedia.c3sl.ufpr.br/"
    "http://dumps.wikimedia.org/"
    ))
(defparameter *wikimedia-site-xdump-list*
  '(;; Wikimedia Foundation (primary)                   ; try not to burden
    "http://dumps.wikimedia.org/"                       ; has `index.html'
    ;; your.org                                         ; jointly run w/ WMF
    "http://dumps.wikimedia.your.org/"                  ; has `index.html'
    "rsync://ftpmirror.your.org/wikimedia-dumps/"
    "ftp://ftpmirror.your.org/pub/wikimedia/dumps/"
    ;; C3SL
    "http://wikipedia.c3sl.ufpr.br/"                    ; no `latest' dir
    "rsync://wikipedia.c3sl.ufpr.br/wikipedia/"
    "ftp://wikipedia.c3sl.ufpr.br/wikipedia/"
    ;; Masaryk University                               ; nothing after 2012
    "http://ftp.fi.muni.cz/pub/wikimedia/"              ; not UTF-8; ISO-8859-1
    "rsync://ftp.fi.muni.cz/pub/wikimedia/"
    "ftp://ftp.fi.muni.cz/pub/wikimedia/"
    ))
;; URLs for wikimedia incremental XML dump files
(defparameter *wikimedia-site-xincr*      nil)
(defparameter *wikimedia-site-xincr-fallback-list*      ; incremental dumps
  '("http://darkstar-5/wikimedia/other/incr/"           ; test site
    "http://dumps.wikimedia.your.org/other/incr/"
    "http://dumps.wikimedia.org/other/incr/"
    ))
(defparameter *wikimedia-site-xincr-list*
  '("http://dumps.wikimedia.your.org/other/incr/"
    ;; "http://wikipedia.c3sl.ufpr.br/other/incr/"      ; 404
    "http://dumps.wikimedia.org/other/incr/"
    ))

;;;
;;; Design Note:
;;;
;;; We would like all the file encodings to be UTF-8.  In
;;; `/etc/mysql/conf.d/wp-mirror.cnf' we have:
;;;
;;; [mysqld]
;;; character-set-server = utf8
;;; collation-server     = utf8_general_ci
;;; [mysql]
;;; default-character-set = utf8
;;;
;;; All the sites that serve `xdump's claim to use UTF-8 as well.
;;; However, in one case, the claim is false.
;;;
;;; (shell) curl --head http://ftp.fi.muni.cz/
;;; HTTP/1.1 200 OK
;;; Server: Apache/2.2.22 (Fedora)
;;; Content-Type: text/html;charset=UTF-8
;;;
;;; actually uses ISO-8859-1.
;;;
(setq *default-file-encoding*
      (ext:make-encoding
       :charset charset:utf-8
       :input-error-action :error))
;;       :input-error-action #\uFFFD)) ; <--- Unicode Replacement Character

(defparameter *wikimedia-language-code-list*
  '(;; other-keep
    "advisory"  "beta"        "commons"  "donate"  "foundation"
    "incubator" "mediawiki"   "meta"     "quality" "sources"
    "species"   "strategyapp" "strategy" "test"    "test2"
    "tokipona"  "wikidata"
    "wikimania2005" "wikimania2006" "wikimania2007" "wikimania2008"
    "wikimania2009" "wikimania2010" "wikimania2011" "wikimania2012"
    "wikimania2013" "wikimania2014" "wikimania2015"
    ;; See <http://meta.wikimedia.org/wiki/List_of_Wikipedias>
    ;; Ordered by size as of 2014-04-26
    ;; 1,000,000+					   
    "en" "nl" "de" "sv" "fr"             "it" "ru" "es" "pl"
    ;;   100,000+
    "war" "ja" "ceb" "vi" "pt"           "zh" "uk" "ca" "no" "fa"
    "id" "fi" "cs" "ar" "ko"             "hu" "ms" "sr" "ro" "tr"
    "min" "kk" "eo" "sk" "da"            "eu" "lt" "bg" "sh" "he"
    "hr" "sl" "uz" "et" "vo"             "hy" "nn" "gl" "simple" "hi"
    "la" "az" "el"
    ;;    10,000+
    "th" "oc" "la" "ka" "mk"             "be" "new" "pms" "tl" "ta"
    "te" "tt" "cy" "lv" "ht"             "be-x-old" "sq" "ur" "bs" "br"
    "jv" "mg" "lb" "mr" "is"             "ml" "pnb" "ba" "my" "af"
    "yo" "ga" "an" "zh-yue" "bn"         "tg" "lmo" "fy" "cv" "ky"
    "sw" "io" "ne" "gu" "bpy"            "ce" "scn" "sco" "nds" "ku"
    "ast" "qu" "su" "als" "kn"           "am" "ia" "nap" "bug" "ckb"
    "bat-smg" "wa" "map-bms" "gd" "mn"   "arz" "mzn" "zh-min-nan" "yi" "si"
    "pa" "sah" "vec" "sa"

    ;;     1,000+
    "nah" "bar" "os" "fo" "roa-tara"     "pam" "hsb" "or" "se" "li"
    "mi" "ilo" "co" "hif" "gan"          "frr" "bo" "glk" "rue" "bcl"
    "nds-nl" "fiu-vro" "mrj" "ps" "tk"   "vls" "gv" "xmf" "pag" "diq"
    "km" "zea" "kv" "mhr" "csb"          "vep" "ay" "hak" "dv" "so"
    "nrm" "rm" "udm" "zh-classical" "koi" "sc" "ug" "lad" "stq" "wuu"
    "lij" "fur" "mt" "eml" "as"          "pi" "nov" "bh" "gn" "ksh"
    "pcd" "kw" "ang" "gag" "szl"         "ace" "nv" "ext" "ie" "frp"
    "mwl" "sn" "ln" "dsb" "crh"          "pfl" "lez" "krc" "haw" "pdc"
    "xal" "kab" "rw" "myv" "to"          "arc" "kl" "bjn" "pap" "kbd"
    "lo" "tpi" "lbe" "wo" "jbo"          "mdf" "cbk-zam" "av" "ty" "srn"
    "bxr"

    ;;       100+
    "ig" "kg" "tet" "na" "ab"            "ltg" "nso" "za" "kaa" "zu"
    "ha" "chy" "rmy" "cu" "chr"          "tn" "cdo" "roa-rup" "bi" "got"
    "pih" "tyv" "tw" "sm" "mo"           "bm" "iu" "ss" "sd" "pnt"
    "ki" "rn" "xh" "om" "ee"             "ts" "ak" "fj" "ti" "ks"
    "sg" "ff" "ve" "cr" "lg"             "st" "dz" "tum" "ik" "ny" "ch"

    ;;        10+
    "ng" "ii" "cho" "mh"
    ;;         1+
    "aa" "kj" "ho" "mus" "kr"
    ;;         0
    "hr"
    ))
(defparameter *wikimedia-project-suffix-alist*
  '(("wikibooks"   . "wikibooks"  )
    ("wikimedia"   . "wikimedia"  )
    ("wikinews"    . "wikinews"   )
    ("wikipedia"   . "wiki"       )
    ("wikiquote"   . "wikiquote"  )
    ("wikisource"  . "wikisource" )
    ("wikiversity" . "wikiversity")
    ("wikivoyage"  . "wikivoyage" )
    ("wiktionary"  . "wiktionary" )
    ))
(defparameter *wikimedia-server-alist*
  '(;; from <https://noc.wikimedia.org/conf/InitialiseSettings.php>, 'wgServer'
    ("advisorywiki" . "advisory.wikimedia.site")
    ("arbcom_dewiki" . "arbcom-de.wikipedia.site")
    ("arbcom_enwiki" . "arbcom-en.wikipedia.site")
    ("arbcom_fiwiki" . "arbcom-fi.wikipedia.site")
    ("arbcom_nlwiki" . "arbcom-nl.wikipedia.site")
    ("arwikimedia" . "ar.wikimedia.site")
    ("auditcomwiki" . "auditcom.wikimedia.site")
    ("boardgovcomwiki" . "boardgovcom.wikimedia.site")
    ("boardwiki" . "board.wikimedia.site")
    ("brwikimedia" . "br.wikimedia.site")
    ("chairwiki" . "chair.wikimedia.site")
    ("chapcomwiki" . "chapcom.wikimedia.site")
    ("checkuserwiki" . "checkuser.wikimedia.site")
    ("collabwiki" . "collab.wikimedia.site")
    ("commonswiki" . "commons.wikimedia.site")
    ("donatewiki" . "donate.wikimedia.site")
    ("execwiki" . "exec.wikimedia.site")
    ("fdcwiki" . "fdc.wikimedia.site")
    ("foundationwiki" . "wikimediafoundation.site")
    ("grantswiki" . "grants.wikimedia.site")
    ("iegcomwiki" . "iegcom.wikimedia.site")
    ("incubatorwiki" . "incubator.wikimedia.site")
    ("internalwiki" . "internal.wikimedia.site")
    ("legalteamwiki" . "legalteam.wikimedia.site")
    ("loginwiki" . "login.wikimedia.site")
    ("mediawikiwiki" . "www.mediawiki.site")
    ("metawiki" . "meta.wikimedia.site")
    ("movementroleswiki" . "movementroles.wikimedia.site")
    ("mxwikimedia" . "mx.wikimedia.site")
    ("noboard_chapterswikimedia" . "noboard-chapters.wikimedia.site")
    ("nycwikimedia" . "nyc.wikimedia.site")
    ("officewiki" . "office.wikimedia.site")
    ("ombudsmenwiki" . "ombudsmen.wikimedia.site")
    ("otrs_wikiwiki" . "otrs-wiki.wikimedia.site")
    ("outreachwiki" . "outreach.wikimedia.site")
    ("pa_uswikimedia" . "pa-us.wikimedia.site")
    ("qualitywiki" . "quality.wikimedia.site")
    ("searchcomwiki" . "searchcom.wikimedia.site")
    ("sourceswiki" . "wikisource.site")
    ("spcomwiki" . "spcom.wikimedia.site")
    ("specieswiki" . "species.wikimedia.site")
    ("stewardwiki" . "steward.wikimedia.site")
    ("strategywiki" . "strategy.wikimedia.site")
    ("transitionteamwiki" . "transitionteam.wikimedia.site")
    ("tenwiki" . "ten.wikipedia.site")
    ("testwiki" . "test.wikipedia.site")
    ("testwikidatawiki" . "test.wikidata.site")
    ("usabilitywiki" . "usability.wikimedia.site")
    ("votewiki" . "vote.wikimedia.site")
    ("vewikimedia" . "ve.wikimedia.site")
    ("wg_enwiki" . "wg-en.wikipedia.site")
    ("wikidatawiki" . "www.wikidata.site")
    ("wikimania2005wiki" . "wikimania2005.wikimedia.site")
    ("wikimania2006wiki" . "wikimania2006.wikimedia.site")
    ("wikimania2007wiki" . "wikimania2007.wikimedia.site")
    ("wikimania2008wiki" . "wikimania2008.wikimedia.site")
    ("wikimania2009wiki" . "wikimania2009.wikimedia.site")
    ("wikimania2010wiki" . "wikimania2010.wikimedia.site")
    ("wikimania2011wiki" . "wikimania2011.wikimedia.site")
    ("wikimania2012wiki" . "wikimania2012.wikimedia.site")
    ("wikimania2013wiki" . "wikimania2013.wikimedia.site")
    ("wikimania2014wiki" . "wikimania2014.wikimedia.site")
    ("wikimania2015wiki" . "wikimania2015.wikimedia.site")
    ("wikimaniateamwiki" . "wikimaniateam.wikimedia.site")
    ("zerowiki" . "zero.wikimedia.site")
    ))
(defparameter *wikimedia-idump-list*   nil) ; list is downloaded from idump site
(defparameter *wikimedia-wiki-list*    nil) ; list is downloaded from xdump site


;;;;--------------------------------------------------------------------------+
;;;; Configuration File:                                                      |
;;;;   Read config file, apply sanity checks, redefine parameters             |
;;;;--------------------------------------------------------------------------+


(defun put-parameters (&key (put nil))
  "Showing parameter values"
  (put-symbol-value-table
   '(*db-name* *db-server* *db-type* *db-wikiadmin-user* *db-wikiuser-user*
     *db-wpmirror-name*
     *debug-level*
     *mediawiki-version* *mediawiki-extension-link-list*
     *mediawiki-php-xdebug-max-nesting-level*
     *mirror-commons* *mirror-commonswiki*
     *mirror-dchunk-page-count*
     *mirror-download-connection-time-max*
     *mirror-host-name-elasticsearch*
     *mirror-image-download-p*
     *mirror-innodb-fast-index-creation*
     *mirror-innodb-table-key-block-size-list*
     *mirror-language-code-list*
     *mirror-objectcache-delete-limit* *mirror-objectcache-threshold*
     *mirror-process-xml* *mirror-profiles-max* *mirror-project-list*
     *mirror-sleep-list* *mirror-sleep-timeout-sec-max*
     *mirror-schunk-page-count*
     *mirror-split-sql*
     *mirror-timeout-sec-importdump*
     *mirror-virtual-host-name*
     *mirror-wiki-list*
     *mirror-wikidata* *mirror-wikidatawiki*
     *mirror-xchunk-concurrency-limit* *mirror-xchunk-page-count*
     *mirror-xchunk-page-count-min* *mirror-xchunk-page-count-max*
     *monitor-gui-font-preference-list* *monitor-mode*
     *monitor-poll-sec* *monitor-poll-sec-min* *monitor-poll-sec-max*
     *system-cpu* *system-cpu-min* *system-cpu-max*
     *system-hdd-write-cache* *system-hdd-write-cache-flush*
     *system-partition-free-images-min*
     *system-partition-free-images-start-min*
     *system-partition-free-images-warn* *system-partition-free-innodb-min*
     *system-physical-memory-min*
     *whereis-apache2ctl*
     *whereis-bashrc* *whereis-bunzip2* *whereis-bzcat* *whereis-bzip2*
     *whereis-cat* *whereis-chmod* *whereis-chown* *whereis-convert*
     *whereis-cp* *whereis-curl* *whereis-curlrc*
     *whereis-directory-apache-sites-available*
     *whereis-directory-apache-sites-enabled*
     *whereis-directory-cron*
     *whereis-directory-mediawiki*
     *whereis-directory-mediawiki-cache*
     *whereis-directory-mediawiki-config*
     *whereis-directory-mediawiki-extensions-cirrussearch-maintenance*
     *whereis-directory-mediawiki-extensions-localisation-update*
     *whereis-directory-mediawiki-extensions-math-math*
     *whereis-directory-mediawiki-extensions-math-texvccheck*
     *whereis-directory-mediawiki-extensions-titlekey*
     *whereis-directory-mediawiki-images*
     *whereis-directory-mediawiki-licenses*
     *whereis-directory-mediawiki-maintenance*
     *whereis-directory-mysql-config*
     *whereis-directory-mysql-config-conf.d*
     *whereis-directory-mysql-datadir*
     *whereis-directory-php-mods-available*
     *whereis-directory-tmp*
     *whereis-directory-wpmirror-config*
     *whereis-directory-wpmirror-restore*
     *whereis-directory-wpmirror-working*
     *whereis-directory-www*
     *whereis-du*
     *whereis-echo* *whereis-env*
     *whereis-file-cron*
     *whereis-file-dev-null* *whereis-file-etc-hosts*
     *whereis-file-mediawiki-config-all-dblist*
     *whereis-file-mediawiki-config-initialisesettings*
     *whereis-file-mediawiki-config-localsettings*
     *whereis-file-mediawiki-config-localsettings-account*
     *whereis-file-mediawiki-config-localsettings-wpmirror*
     *whereis-file-mediawiki-extensions-cirrussearch-forcesearchindex*
     *whereis-file-mediawiki-extensions-cirrussearch-updatesearchindexconfig*
     *whereis-file-mediawiki-extensions-localisation-update*
     *whereis-file-mediawiki-extensions-titlekey-rebuild-titlekey*
     *whereis-file-mediawiki-farm-database*
     *whereis-file-mediawiki-farm-importdump*
     *whereis-file-mediawiki-farm-runjobs*
     *whereis-file-mediawiki-farm-update*
     *whereis-file-mediawiki-favicon*
     *whereis-file-mediawiki-logo*
     *whereis-file-mediawiki-update*
     *whereis-file-mysql-config-debian* *whereis-file-mysql-config-wpmirror*
     *whereis-file-mysql-log-file*
     *whereis-file-php-xdebug*
     *whereis-file-symbolic-link-to-mediawiki*
     *whereis-file-tmp-http*
     *whereis-file-virtual-host*
     *whereis-file-wpmirror-config-default*
     *whereis-file-wpmirror-config-local*
     *whereis-file-wpmirror-log* *whereis-file-wpmirror-pid*
     *whereis-gawk* *whereis-gm* *whereis-grep* *whereis-gunzip* *whereis-gzip*
     *whereis-hdparm* *whereis-inkscape* *whereis-invoke-rc.d*
     *whereis-ls* *whereis-lua*
     *whereis-md5sum* *whereis-mv* *whereis-mwxml2sql*
     *whereis-mysql* *whereis-mysqladmin* *whereis-mysqldump*
     *whereis-mysql-tzinfo-to-sql*
     *whereis-openssl* *whereis-php*
     *whereis-replace* *whereis-rm* *whereis-rsvg* *whereis-rsync*
     *whereis-split*
     *whereis-tar* *whereis-texvc* *whereis-texvccheck* *whereis-timeout*
     *whereis-wc* *whereis-wget* *whereis-wgetrc*
     *whereis-x*
     *whereis-zcat* *whereis-zgrep* *whereis-zoneinfo*
     *wikimedia-large-language-code-list*
     *wikimedia-xdump-type* *wikimedia-xdump-type-list*
     *wikimedia-xdump-type-string-list*
     *wikimedia-path-checksums-template*
     *wikimedia-path-idump-template*
     *wikimedia-path-sdump-template-import-list*
     *wikimedia-path-sdump-template-xml2sql-list*
     *wikimedia-path-sdump-template-wikidata-list*
     *wikimedia-path-xincr-template-list*
     *wikimedia-site-idump* *wikimedia-site-image* *wikimedia-site-xdump*
     *wikimedia-site-idump-list* *wikimedia-site-image-list*
     *wikimedia-site-xdump-list* *wikimedia-site-xdump-dirlist*
     *wikimedia-language-code-list*
     *wikimedia-project-suffix-alist*
     *wikimedia-server-alist*
     *wikimedia-wiki-list*
     *wpmirror-config-restore-list*)
   :put put)
  t)

(defun process-configuration-files-or-die (&key (put nil))
  "Loading configuration file"
  ;; 0) load config files
  (let ((path-default (merge-pathnames
	       (parse-namestring *whereis-directory-wpmirror-config*)
	       (parse-namestring *whereis-file-wpmirror-config-default*)))
	(path-local   (merge-pathnames
	       (parse-namestring *whereis-directory-wpmirror-config*)
	       (parse-namestring *whereis-file-wpmirror-config-local*))))
    ;; default config file
    (put-message-value (_ "probing") path-default :put put)
    (unless (file-exists-p path-default :put put)
      (put-message-value-fail-and-abort (_ "file not found") path-default))
    ;;(load path-default :if-does-not-exist nil)
    ;;(put-message-done (_ "default config file loaded"))
    (put-message-done (_ "default config file found, not loaded") :put put)
    ;; local config file
    (put-message-value (_ "probing") path-local :put put)
    (unless (file-exists-p path-local :put put)
      (put-message-value-fail-and-abort (_ "file not found") path-local))
    (load path-local :if-does-not-exist nil)
    (put-message-done (_ "local config file loaded") :put put))

  ;; 1) keep the monitor polling rate within reasonable bounds
  (put-message-start (_ "checking range *monitor-poll-sec*") :put put)
  (put-message-value (_ "reasonable bounds would be")
		     (format nil "[~d,~d]" *monitor-poll-sec-min* 
			     *monitor-poll-sec-max*) :put put)
  (setq *monitor-poll-sec* (value-within-bound *monitor-poll-sec-min*
					       *monitor-poll-sec*
					       *monitor-poll-sec-max*))
  (put-message-value-done (_ "checking range *monitor-poll-sec*")
			  *monitor-poll-sec* :put put)
  ;; 2) return
  (let ((path-default (merge-pathnames
	       (parse-namestring *whereis-directory-wpmirror-config*)
	       (parse-namestring *whereis-file-wpmirror-config-default*))))
    (file-exists-p path-default :put put)))


;;;;--------------------------------------------------------------------------+
;;;; Command Line:                                                            |
;;;;   Read command line options, apply sanity checks, redefine parameters    |
;;;;--------------------------------------------------------------------------+


(defun put-copyright-license-and-disclaimer-and-die (&key (put t))
  "Showing copyright, license, and disclaimer, and die."
  (format *standard-output* "~a~%" *copyright-license-and-disclaimer*)
  (die))

(defun put-help-and-die ()
  "Showing help message, and die."
  (format *standard-output* "~a~%" *help*)
  (die))

(defun put-version-and-die (&key (put t))
  "Showing version, copyright, and author, and die."
  (format *standard-output* "~a~%~%" *version*)
  (format *standard-output* "~a~%~%" *copyright-license-and-disclaimer*)
  (format *standard-output* "~a~%"   *author*)
  (die))

(defun put-wtf-and-die ()
  "Telling user how to get help, and die."
  (format *standard-output* "~a~%" *wtf*)
  (die))

(defun process-command-line-arguments-or-die (&key (put nil))
  "Processing any command line arguments using getopt."
  (multiple-value-bind (filtered opt-args unexpected)
      ;; 0) parse command-line
      ;;    o FILE (if given) should be in `filtered',
      ;;    o options (and their arguments) should be in `opt-args', and
      ;;    o anything invalid should be in `unexpected'
      (getopt:getopt ext:*args*
		     '(("add"                    :optional nil)
		       ("copyright"              :none     nil)
		       ("debug"                  :none     nil)
		       ("delete"                 :optional nil)
		       ("drop"                   :optional nil)
		       ("dump"                   :optional nil)
		       ("gui"                    :none     nil)
		       ("help"                   :none     nil)
		       ("info"                   :none     nil)
		       ("mirror"                 :optional nil)
		       ("monitor"                :none     nil)
		       ("profile"                :optional nil)
		       ("restore-default"        :none     nil)
		       ("screen"                 :none     nil)
		       ("text"                   :none     nil)
		       ("update"                 :optional nil)
		       ("version"                :none     nil)
		       ))
    (when (assoc "debug"            opt-args :test #'string=) ; --debug
      (defparameter *debug-level* (1+ *debug-level*)))
    (debug-message-start (_ "Processing command line arguments"))
    (debug-message-start (_ "List packages and globals "))
    (debug-message-value "custom:*ansi*" custom:*ansi*)
    (debug-message-value "*package*"    *package*)
    (debug-message-value "*print-case*" *print-case*)
    (debug-message-start (_ "Parse command line"))
    (debug-message-value (_ "ext:*args*") ext:*args*)
    (debug-message-value (_ "filtered")   filtered)
    (debug-message-value (_ "opt-args")   opt-args)
    (debug-message-value (_ "unexpected") unexpected)
    (debug-message-done  (_ "Parse command line"))
    ;; 1) detect user who needs help and die
    (when (assoc "copyright"        opt-args :test #'string=) ; --copyright
      (put-copyright-license-and-disclaimer-and-die))
    (when (assoc "add"              opt-args :test #'string=) ; --add
      (put-message (assoc "add" opt-args :test #'string=) :put put)
      (let ((wiki (cdr (assoc "add" opt-args :test #'string=))))
	(setq *main-wiki*           wiki)
	(setq *main-mode*           :add)))
    (when (assoc "delete"           opt-args :test #'string=) ; --delete
      (put-message (assoc "delete" opt-args :test #'string=) :put put)
      (let ((wiki (cdr (assoc "delete" opt-args :test #'string=))))
	(setq *main-wiki*           wiki)
	(setq *main-mode*           :delete)))
    (when (assoc "drop"             opt-args :test #'string=) ; --drop
      (put-message (assoc "drop" opt-args :test #'string=) :put put)
      (let ((wiki (cdr (assoc "drop" opt-args :test #'string=))))
	(setq *main-wiki*           wiki)
	(setq *main-mode*           :drop)))
    (when (assoc "dump"             opt-args :test #'string=) ; --dump
      (put-message (assoc "dump" opt-args :test #'string=) :put put)
      (let ((wiki (cdr (assoc "dump" opt-args :test #'string=))))
	(setq *main-wiki*           wiki)
	(setq *main-mode*           :dump)))
    (when (assoc "restore-default"  opt-args :test #'string=) ;--restore-default
      (put-message (assoc "restore-default" opt-args :test #'string=) :put put)
      (setq *main-mode*             :restore-default))
    (when (assoc "help"             opt-args :test #'string=) ; --help
      (put-help-and-die))
    (when (assoc "info"             opt-args :test #'string=) ; --info
      (put-message (assoc "info" opt-args :test #'string=) :put put)
      (assert-configuration-files-or-restore-default :put nil)
      (process-configuration-files-or-die :put nil)
      (put-parameters :put t)
      (put-copyright-license-and-disclaimer-and-die))
    (when (assoc "profile"          opt-args :test #'string=) ; --profile
      (put-message (assoc "profile" opt-args :test #'string=) :put put)
      (let ((run (cdr (assoc "profile" opt-args :test #'string=))))
	(setq *main-run*            run)
	(setq *main-mode*           :profile)))
    (when (assoc "update"           opt-args :test #'string=) ; --update
      (put-message (assoc "update" opt-args :test #'string=) :put put)
      (let ((wiki (cdr (assoc "update" opt-args :test #'string=))))
	(setq *main-wiki*           wiki)
	(setq *main-mode*           :update)))
    (when (assoc "version"          opt-args :test #'string=) ; --version
      (put-version-and-die))
    (when unexpected
      (put-message-start (_ "Error: command line") :put t)
      (put-message-value-fail (_ "unexpected option~p")
			      (length unexpected) unexpected)
      (put-wtf-and-die))
    (when (> (length filtered) 1)                      ; more than one FILE
      (put-message-start (_ "Error: command line") :put t)
      (put-message-value-fail (_ "saw more than one file") filtered)
      (put-wtf-and-die))
    (when (assoc "monitor"          opt-args :test #'string=) ; --monitor
      (setq *monitor-mode*          :auto)
      (setq *cmd-force-monitor*     t))
    (when (assoc "gui"              opt-args :test #'string=) ; --gui
      (setq *monitor-mode*          :gui)
      (setq *cmd-force-monitor*     t))
    (when (assoc "screen"           opt-args :test #'string=) ; --screen
      (setq *monitor-mode*          :screen)
      (setq *cmd-force-monitor*     t))
    (when (assoc "text"             opt-args :test #'string=) ; --text 
      (setq *monitor-mode*          :text)
      (setq *cmd-force-monitor*     t))
    (when (assoc "mirror"           opt-args :test #'string=) ; --mirror
      (setq *cmd-force-mirror*      t)
      (setq *cmd-force-monitor*     nil)                      ; override
      (put-message (assoc "mirror" opt-args :test #'string=) :put put)
      (let ((arg (cdr (assoc "mirror" opt-args :test #'string=))))
	(when (not (null arg))
	  (cond ((string= arg "media")
		 (setq *mirror-xdump-download-p* nil      ))
		((string= arg "reimport")
		 (setq *mirror-process-xml*      :import  ))
		((string= arg "reimport")
		 (setq *mirror-process-xml*      :thumb   ))
		((string= arg "xml2sql")
		 (setq *mirror-process-xml*      :xml2sql ))
		(t (put-message-value-fail-and-abort (_ "unknown arg") arg))))))
    (when (assoc "debug"            opt-args :test #'string=) ; --debug
      (setq *monitor-mode*          :text))                   ; forces --text
    ;; 2) set configuration file (if given on command-line)
    (when filtered
      (defparameter *whereis-file-wpmirror-config-local* (first filtered))
      (assert-file-exists-p *whereis-file-wpmirror-config-local* :put put))
  (put-message-done (_ "processing command line arguments") :put put)
  t))


;;;;--------------------------------------------------------------------------+
;;;; Shell utilities:                                                         |
;;;;   Some tasks are more easily done with existing utilities.               |
;;;;   Avoid reinventing the wheel (absent compelling reasons).               |
;;;;--------------------------------------------------------------------------+


(defun shell-apache2-restart (&key (put nil))
  "Restart `apache2' server"
  (let ((command-string (format nil "~a restart" *whereis-apache2*)))
    (shell-command command-string :put put)))

(defun shell-apache2ctl-grep-vhost-p (&key (put nil))
  "Determining if Apache2 was loaded with wp-mirror virtual host"
  (let ((command-string (format nil "~a -S 2>&1 | ~a ~s"
				*whereis-apache2ctl*
				*whereis-grep*
				*mirror-virtual-host-name*)))
    (shell-command command-string :output :read-lines :put put)))

(defun shell-bunzip2 (file-name &key (put nil))
  "Decompressing `bzip2' file"
  (let ((command-string (format nil "~a --force --keep ~a"
				*whereis-bunzip2* file-name)))
    (shell-command command-string :put put)))

(defun shell-cat-append (file-name-source file-name-dest &key (put nil))
  "Appending contents of first file onto second file"
  (let ((command-string (format nil "~a ~a >> ~a"
				*whereis-cat* file-name-source file-name-dest)))
    (shell-command command-string :put nil)))

(defun shell-cat-grep (file-name pattern &key (put nil))
  "Grepping a file for a line matching pattern"
  (let ((command-string (format nil "~a ~s | ~a ~s" 
				*whereis-cat*
				file-name
				*whereis-grep*
				pattern)))
    (shell-command command-string :output :read-lines :put nil)))

(defun shell-cat-grep-wc (file-name pattern &key (put nil))
  "Grepping a file for a line matching pattern"
  (let ((command-string (format nil "~a ~s | ~a ~s | ~a -l" 
				*whereis-cat*
				file-name
				*whereis-grep*
				pattern
				*whereis-wc*)))
    (shell-command command-string :output :read :put nil)))

(defun shell-chmod (file-name &key (permissions "744") (put nil))
  "Chmod file"
  (let ((command-string (format nil "~a ~a ~a"
				*whereis-chmod*	permissions file-name)))
    (shell-command command-string :put nil)))

(defun shell-chown (file-name &key (owner "www-data:www-data") (put nil))
  "Chown file"
  (let ((command-string (format nil "~a ~a ~a"
				*whereis-chown* owner file-name)))
    (shell-command command-string :put nil)))

(defun shell-chown-dir (dir-name &key (owner "www-data:www-data") (put nil))
  "Chown directory recursively"
  (let ((command-string (format nil "~a --recursive ~a ~a"
				*whereis-chown*	owner dir-name)))
    (shell-command command-string :put nil)))

(defun shell-command (command-string &key (input :terminal)
				     (output :terminal)
				     (if-output-exists :overwrite) (put nil))
  "Run shell command, put messages before and after"
  ;;
  ;; Design note:
  ;;
  ;; Purpose: wrap `ext:run-shell-command' with messages; and to read
  ;; and return any output.
  ;;
  ;; command-string - is a valid shell commmand
  ;;
  ;; `:input' - where program's input is to come either from:
  ;; o `:terminal' (`stdin', the default);
  ;; o `:stream' (a Lisp `stream' to be created);
  ;; o a pathname designator (an input file);
  ;; o `nil' (no input at all).
  ;; Do not use `nil' as it messes up certain command-strings
  ;; (e.g. `env printf %s some-string | openssl dgst -md5').
  ;;
  ;; `:output' - where the program's output is to be sent either to:
  ;; o `:terminal' (`stdout', the default);
  ;; o `:read' (a Lisp `stream' to be created and read with `read');
  ;; o `:read-line' (a Lisp `stream' to be created, read once with
  ;;    `read-line', returning a string);
  ;; o `:read-lines' (a Lisp `stream' to be created, read until `EOF',
  ;;    returning list of strings);
  ;; o a pathname designator (an output file); or
  ;; o `nil' (no input at all).
  ;;
  ;; `:if-output-exists' - what to do if the `:output' file already
  ;; exists. The possible values are:
  ;; o `:overwrite' (the default);
  ;; o `:append'; or
  ;; o `:error';
  ;; with the same meaning as for `open'.
  ;;
  ;; `:put' - where to write messages either:
  ;; o `nil' (write to log file only); or
  ;; o `t' (write to both `stdout' and to log file).
  ;;
  ;;
  ;; Design note:
  ;;
  ;; Parsing the command-string requires finesse.
  ;;
  ;; 1) This first version fails due to LOCALE mismatch (clisp uses
  ;; UTF-8, shell uses POSIX). Example, if command-string contain
  ;; unicode:
  ;;
  ;;  (setq message (first (regexp:regexp-split " " command-string)))
  ;;
  ;;  *** - MAKE-ARRAY: dimension -1 is not of type `(INTEGER 0
  ;;  (,ARRAY-DIMENSION-LIMIT))
  ;;
  ;; 2) This second version works:
  ;;
  ;;  (setq message (subseq command-string 0
  ;;		            (regexp:match-start
  ;;			     (regexp:match " " command-string))))
  ;;
  (let* ((match-p        (regexp:match " " command-string))
	 (message        (if (null match-p)
			     command-string
			   (subseq command-string 0
				   (regexp:match-start match-p))))
	 (message-return (format nil "~a returned" message))
	 (output-stream  nil)
	 (result         nil))
    (put-message-start command-string :put put)
    (case output
	  (:read
	   (setq output-stream  (ext:run-shell-command command-string
						       :input input
						       :output :stream))
	   (setq result         (with-open-stream (s output-stream)
				  (read s nil 'eof))))
	  (:read-line
	   (setq output-stream  (ext:run-shell-command command-string
						       :input input
						       :output :stream))
	   (setq result         (with-open-stream (s output-stream)
				  (read-line s nil 'eof))))
	  (:read-lines
	   (setq output-stream  (ext:run-shell-command command-string
						       :input input
						       :output :stream))
	   (setq result         (with-open-stream (s output-stream)
				  (put-message (stream-external-format s)
					       :put put)
				  (do ((l (read-line s nil 'eof)
					  (read-line s nil 'eof)))
				      ((eq l 'eof) (nreverse result))
				      (push l result)))))
	  (otherwise   ; `:terminal', a pathname, or `nil'
	   (setq result         (ext:run-shell-command command-string
						       :input input
						       :output output
					:if-output-exists if-output-exists))))
    (when (streamp output-stream)
      (close output-stream))
    (case result
	  ('eof (put-message-value      message-return result :put put))
	  (nil  (put-message-value      message-return result :put put))
	  (t    (put-message-value      message-return result :put put)))
    result))

(defun shell-copy-file (file-name dir-name &key (put nil))
  "Copying file to destination directory"
  (let* ((command-string (format nil "~a -a ~a ~a"
				 *whereis-cp* file-name dir-name))
	 (result         (shell-command command-string :put nil)))
    (when result (abort-and-die))))

(defun shell-count-dir (dir-name &key (put nil))
  "Counting files in directory"
  (let ((command-string (format nil "~a -U ~a | ~a -l"
				*whereis-ls* dir-name *whereis-wc*)))
    (shell-command command-string :output :read :put put)))

(defun shell-count-image (file-name &key (put nil))
  "Counting media files `[[File:' in file"
  (let* ((file-type           (sql-select-file-type file-name))
	 (command-ichunk      (format nil "~a ~a | ~a \"^http\" | wc -l"
				      *whereis-cat*
				      file-name
				      *whereis-grep*))
	 (command-xml-file    (format nil "~a ~a | ~a \"\\[\\[File:\" | wc -l"
				      *whereis-cat*
				      file-name
				      *whereis-grep*))
	 (command-xml-image   (format nil "~a ~a | ~a \"\\[\\[Image:\" | wc -l"
				      *whereis-cat*
				      file-name
				      *whereis-grep*))
	 (command-xml-media   (format nil "~a ~a | ~a \"\\[\\[Media:\" | wc -l"
				      *whereis-cat*
				      file-name
				      *whereis-grep*))
	 (command-xmlbz-file  (format nil "~a ~a | ~a \"\\[\\[File:\" | wc -l"
				      *whereis-bzcat*
				      file-name
				      *whereis-grep*))
	 (command-xmlbz-image (format nil "~a ~a | ~a \"\\[\\[Image:\" | wc -l"
				      *whereis-bzcat*
				      file-name
				      *whereis-grep*))
	 (command-xmlbz-media (format nil "~a ~a | ~a \"\\[\\[Media:\" | wc -l"
				      *whereis-bzcat*
				      file-name
				      *whereis-grep*)))
    (cond ((string= file-type "ichunk")
	   (shell-command command-ichunk :output :read :put put))
	  ((string= file-type "xml")
	   (+ (shell-command command-xml-file    :output :read :put put)
	      (shell-command command-xml-image   :output :read :put put)
	      (shell-command command-xml-media   :output :read :put put)))
	  ((string= file-type "xchunk")
	   (+ (shell-command command-xmlbz-file  :output :read :put put)
	      (shell-command command-xmlbz-image :output :read :put put)
	      (shell-command command-xmlbz-media :output :read :put put)))
	  (t 0))))

(defun shell-count-images (file-name &key (put nil))
  "Counting media files"
  (let* ((image-dir      (directory-namestring
			  (file-name-to-image-directory file-name :put put)))
	 (command-string (format nil "~a -U ~a[0-9a-f]/* 2> ~a | ~a -l"
				 *whereis-ls*
				 image-dir
				 *whereis-file-dev-null*
				 *whereis-wc*)))
    (shell-command command-string :output :read :put put)))

(defun shell-du (dir-name &key (put nil))
  "Measuring disk usage (bytes) for given directory"
  (let* ((dir-namestring (directory-namestring dir-name))
	 (command-string (format nil "~a -sb ~a"
				 *whereis-du*
				 dir-namestring)))
    (if (ext:probe-directory dir-name)
	(shell-command command-string :output :read :put put)
      0)))

(defun shell-du-mediawiki-images (&key (put nil))
  "Measuring disk usage (bytes) for mediawiki images directory"
  (shell-du *whereis-directory-mediawiki-images* :put put))

(defun shell-du-mysql-datadir (&key (put nil))
  "Measuring disk usage (bytes) for data directory"
  (shell-du *whereis-directory-mysql-datadir* :put put))

(defun shell-du-wpmirror-working (&key (put nil))
  "Measuring disk usage (bytes) for mediawiki working directory"
  (shell-du *whereis-directory-wpmirror-working* :put put))

(defun shell-ping-site (site-name &key (put nil))
  "Asserting IPv4 access to site"
  (let* ((command-string (format nil "~a -c 3 ~a 2>&1"
				 *whereis-ping* site-name))
	 (result         (shell-command command-string :output :read-lines
					:put put))
	 (match          (loop
			  for line of-type string in result
			  thereis (regexp:match "[1-9] received" line))))
    (put-message result :put put)
    (not (null match))))

(defun shell-ping6-site (site-name &key (put nil))
  "Asserting IPv6 access to url"
  (let* ((command-string (format nil "~a -c 3 ~a 2>&1"
				 *whereis-ping6* site-name))
	 (result         (shell-command command-string :output :read-lines
					:put put))
	 (match          (loop
			  for line of-type string in result
			  thereis (regexp:match "[1-9] received" line))))
    (put-message result :put put)
    (not (null match))))

(defun shell-rsync-connection (url &key (silent t) (put nil))
  "Asserting internet access to wikimedia site"
  (let* ((command-string (concatenate 'string
				      (format nil "~a " *whereis-rsync*)
				      url))
	 (result  (shell-command command-string :output :read-lines :put put)))
    (put-message result :put put)
    (not (null result))))

(defun shell-rsync-directory-list (url &key (put nil))
  "Downloading directory list from URL, return list of strings"
  (let* ((command-string (format nil "~a --list-only ~a" *whereis-rsync* url))
	 (lines          (shell-command command-string
					:output :read-lines :put put))
	 (result         (loop
			   for line in lines
			   collect (first
				    (last (regexp:regexp-split " " line))))))
    (put-message result :put put)
    result))

(defun shell-rsync-file (url file-name &key (silent t) (put nil))
  "Downloading file from URL, save as file-name"
  (let ((command-string (concatenate 'string
			      (format nil "~a " *whereis-rsync*)
			      "--partial --progress "
			      "--copy-links "
			      (format nil "--timeout=~d " 
				      *mirror-download-connection-time-max*)
			      url
			      " .")))
    (shell-command command-string :put put)))

(defun shell-rsync-file-head (url &key (put nil))
  "Downloading directory list from URL, return string"
  (let* ((command-string (format nil "~a --list-only ~a" *whereis-rsync* url))
	 (line           (shell-command command-string
					:output :read-line :put put)))
    (put-message line :put put)
    line))

(defun shell-wget-connection (url &key (silent t) (put nil))
  "Asserting internet access to wikimedia site"
  (let* ((result  (shell-wget-http-file-head url :silent silent :put put)))
    (put-message result :put put)
    (not (null result))))

(defun shell-wget-ftp-directory-list (url &key (silent t) (put nil))
  "Downloading directory list from URL, return list of strings"
  (let* ((command-string (concatenate 'string
				      (format nil "~a -O- " *whereis-wget*)
				      (when silent "--silent ")
				      url))
	 (lines          (shell-command command-string :output :read-lines
					:put put))
	 (result         (loop
			   for line in lines
			   collect (first
				    (last (regexp:regexp-split " " line))))))
    (put-message result :put put)
    result))

(defun shell-wget-http-directory-list (url &key (silent t) (put nil))
  "Downloading directory list from URL, return list of strings"
  (let* ((command-string (concatenate 'string
			      (format nil "~a -O- " *whereis-wget*)
			      (when silent "--quiet ")
			      url))
	 (lines     (shell-command command-string :output :read-lines :put put))
	 (href-list (loop
		      for line in lines
		      as match = (regexp:match "href=\"[^\"]*" line)
		      as item = (and match
				     (subseq line
					     (+ (regexp:match-start match) 6)
					     (regexp:match-end match)))
		      when (and item
				(not (regexp:match "?"     item))
				(not (regexp:match ":"     item))
				(not (regexp:match "css"   item))
				(not (regexp:match "html"  item))
				(not (regexp:match "other" item)))
		        when (char= (aref item (1- (length item))) #\/)
		          collect (subseq item 0 (1- (length item)))
                        else
		          collect item)))
    (put-message href-list :put put) 
    href-list))

(defun shell-wget-http-directory-list-alt (url &key (silent t) (put nil))
  "Downloading directory list from `rsync-dirlist-last-1-good.txt', return list of strings"
  ;;
  ;; Directory note:
  ;;
  ;; At some sites `*wikimedia-site-xdump*' contains an `index.html'
  ;; file that prevents scraping a directory listing from HTML.  
  ;;
  ;; Some sites offer a `rsync-dirlist-last-1-good.txt' file
  ;; containing a list of wikis.  If not, then we look for the message:
  ;;
  ;; <p>The requested URL /rsync-dirlist-last-1-good.txt was not found
  ;; on this server.</p> or <title>404 - Not Found</title>
  ;;
  (let* ((url-last  (format nil "~a~a" url *wikimedia-site-xdump-dirlist*))
	 (command-string (concatenate 'string
			      (format nil "~a -O- " *whereis-wget*)
			      (when silent "--quiet ")
			      url-last))
	 (lines     (shell-command command-string :output :read-lines :put put))
	 (found-p   (not (loop
			   for line in lines
			   as  match = (regexp:match "not found" line
						     :ignore-case t)
			   thereis match)))
	 (wiki-list (and found-p
			 (loop
		           for line in lines
			   as  item = (second (regexp:regexp-split "/" line))
			   collect item))))
    (put-message command-string :put put)
    (put-message wiki-list :put put)
    wiki-list))

(defun shell-wget-file (url file-name &key (silent t) (put nil))
  "Downloading file from URL, save as file-name"
  (let ((command-string (concatenate 'string
			      (format nil "~a --continue " *whereis-wget*)
			      url)))
    (shell-command command-string :put put)))

(defun shell-wget-http-file-head (url &key (silent t) (put nil))
  "Downloading HTTP head from URL, return list of strings"
  (let* ((command-string (concatenate 'string
			      (format nil "~a --server-response --spider "
				      *whereis-wget*)
			      (when silent "--quiet ")
			      "2>&1 "
			      url)))
    (shell-command command-string :output :read-lines :put nil)))

(defun shell-extract-tarball (file-name &key (silent nil) (put nil))
  "Extracting tarball"
  (let ((command-string (concatenate 'string
			      (format nil "~a " *whereis-tar*)
			      (unless silent "--verbose ")
			      "--extract "
			      "--file "
			      file-name)))
    (shell-command command-string :put put)))

(defun shell-wget-input-file (file-name &key (silent t) (put nil))
  "Downloading from URLs listed in file-name"
  ;;
  ;; Design note:
  ;;
  ;; `wget' offers a `--cut-dirs' option that takes a positive integer.
  ;; To set this we need to split the site URL and count the pieces.
  ;;
  ;; URL        `http://ftpmirror.your.org/pub/wikimedia/images/'
  ;; split "/"  ("http:" "" "ftpmirror.your.org" "pub" "wikimedia" "images" "")
  ;; mapcan     ("http:" "ftpmirror.your.org" "pub" "wikimedia" "images")
  ;; length     5
  ;; cut-dirs   3
  ;;
  (let* ((url-split           (mapcan #'(lambda (x) 
					  (when (> (length x) 0) (list x)))
				      (regexp:regexp-split "/" 
					  *wikimedia-site-image*)))
	 (cut-dirs            (- (length url-split) 2))
	 (command-string (concatenate 'string
			      (format nil "~a " *whereis-wget*)
			      (format nil "--input-file=~a " file-name)
			      "--wait=1 "
			      "--restrict-file-names=nocontrol "
			      "--force-directories "
			      "--no-host-directories "
			      (format nil "--cut-dirs=~d " cut-dirs)
			      (when silent "--no-verbose "))))
    (shell-command command-string :put put)))

(defun shell-echo (string file-name &key (put nil))
  "Appending a string + newline to a file"
  (let ((command-string (format nil "~a ~s >> ~a"
				*whereis-echo* string file-name)))
    (shell-command command-string :put put)))

(defun shell-gunzip (file-name &key (put nil))
  "Decompressing `gz' file"
  (let ((command-string (format nil "~a --force ~a"
				*whereis-gunzip* file-name)))
    (shell-command command-string :put put)))

(defun shell-gunzip-keep (file-name &key (put nil))
  "Decompressing `gz' file while keeping it"
  (let* ((next-file      (join (butlast (regexp:regexp-split
					 (regexp:regexp-quote ".") file-name))
			       "."))
	 (command-string (format nil "~a --stdout --force ~a"
				 *whereis-gunzip* file-name)))
    (shell-command command-string :output next-file :put put)))

(defun shell-ln (target link-dir link-name &key (put nil))
  "Creating a link to `target' from `link-dir/link-name'"
  (let* ((path-name      (merge-pathnames
			  (parse-namestring link-dir)
			  (parse-namestring link-name)))
	 (command-string (format nil "ln --symbolic ~a ~a" target path-name)))
    (shell-remove-file path-name :put put)
    (when (null (ext:probe-directory link-dir))
      (ensure-directories-exist link-dir))
    (shell-command command-string :put put)))

(defun shell-ls-grep (dir-name pattern &key (put nil))
  "Grepping a directory listing for file names matching a pattern"
  (let ((command-string (format nil "~a -U ~a | ~a ~s" 
				*whereis-ls* dir-name
				*whereis-grep* pattern)))
    (shell-command command-string :output :read-lines :put put)))

(defun shell-ls-grep-all (dir-name pattern &key (put nil))
  "Grepping a directory listing for all file names matching a pattern"
  (let ((command-string (format nil "~a -Ua ~a | ~a ~s" 
				*whereis-ls* dir-name
				*whereis-grep* pattern)))
    (shell-command command-string :output :read-lines :put put)))

(defun shell-move-file (file-name dir-name &key (put nil))
  "Moving file to destination directory"
  (let* ((command-string (format nil "~a ~a ~a"
				 *whereis-mv* file-name dir-name))
	 (result         (shell-command command-string :put nil)))
    (when result (abort-and-die))))

(defun shell-count-page (file-name &key (put nil))
  "Counting pages `<page>' in file"
  (let* ((file-type      (sql-select-file-type file-name))
	 (command-string (cond
			  ((string= file-type "xchunk")
			   (format nil "~a ~a | ~a \"  <page>\" | wc -l"  
				   *whereis-bzcat*
				   file-name
				   *whereis-grep*))
			  ((string= file-type "xml")
			   (format nil "~a ~a | ~a \"  <page>\" | wc -l"  
				   *whereis-cat*
				   file-name
				   *whereis-grep*))
			  (t nil))))
    (shell-command command-string :output :read :put put)))

(defun shell-gm-identify (pathname &key (put nil))
  "Determining if media file is incomplete or corrupt"
  (let* ((command-string (format nil
				"~a identify -verbose ~s 2>&1 | ~a ~s"
				*whereis-gm*   (namestring pathname)
				*whereis-grep* "gm identify"))
	 (result         (shell-command command-string :output :read-line
					:put nil)))
    (when (eq result 'eof) (setq result nil))
    result))

(defun shell-hdparm-identification-p (block-device &key (put nil))
  "Determining if hard drive provides identification"
  ;;
  ;; Design note:
  ;;
  ;; Disks that do not provide identification are probably virtual
  ;; disks in a Virtual Machine.  They give error messages like:
  ;;
  ;; (root-shell)# hdparm -I /dev/vda
  ;;
  ;; /dev/vda:
  ;; HDIO_DRIVE_CMD(identify) failed: Inappropriate ioctl for device
  ;;
  (let* ((command-string (format nil "~a -I ~a" *whereis-hdparm* block-device))
	 (lines          (shell-command command-string :output :read-lines
					:put put))
	 (count          (length lines)))
    (if (> count 2) t nil)))

(defun shell-hdparm-write-cache-p (block-device &key (put nil))
  "Determining if hard drive write cache has been disabled/enabled"
  (let* ((command-string (format nil "~a -W~d ~a" 
				 *whereis-hdparm*
				 *system-hdd-write-cache*
				 block-device))
	 ;; attempting to disable/enable HDD write cache
	 (lines          (shell-command command-string :output :read-lines
					:put put))
	 ;; ignore first line : (which is blank)
	 ;;    and second     : /dev/sda:
	 ;;    and third      :  setting drive write-caching =  0 (off)
	 ;;                   :  setting drive write-caching =  1 (on)
	 ;; keep fourth       :  write-caching =  0 (off)
	 ;;                   :  write-caching =  1 (on)
	 (line           (fourth lines)))
    ;; confirm that result is the intended one
    (or (and (regexp:match "off" line) (eql *system-hdd-write-cache* 0))
	(and (regexp:match "on"  line) (eql *system-hdd-write-cache* 1)))))

(defun shell-hdparm-write-cache-flush (block-device &key (put nil))
  "Flushing hard drive write cache"
  (let* ((command-string (format nil "~a -F ~a" *whereis-hdparm* block-device))
	 (lines          (shell-command command-string :output :read-lines
					:put put))
	 ;; ignore first line : (which is blank)
	 ;; keep second line  : /dev/sda
	 (line           (second lines)))
    (if (regexp:match block-device line) t nil)))

(defun shell-identify (pathname &key (put nil))
  "Determining if media file is incomplete or corrupt"
  (let* ((command-string (format nil
				"~a -verbose ~s 2>&1 | ~a ~s"
				*whereis-identify*   (namestring pathname)
				*whereis-grep* "identify"))
	 (result         (shell-command command-string :output :read-line
					:put nil)))
    (when (eq result 'eof) (setq result nil))
    result))

(defun hdd-write-cache-flush-all (&key (put nil))
  "Flushing hard drive write cache for each disk underlying InnoDB"
  (when (and
	 *system-hdd-identification-p*
	 *system-hdd-write-cache-flush*)
    (loop
     for hdd-name in *system-hdd-name-list*
     do (put-message-value (_ "flushing hdd write cache") hdd-name :put put)
        (shell-hdparm-write-cache-flush hdd-name :put put))))

(defun shell-md5sum (file-name &key (put nil))
  "Computing file checksum"
  ;;
  ;; Design note:
  ;;
  ;; Implementations of openssl differ.  Have seen two output formats:
  ;; 1) 567f7e60f0369351c5c56a5076cad182
  ;; 2) MD5(Flag_of_Saint_Helena.svg)= 567f7e60f0369351c5c56a5076cad182
  ;;
  (let* ((command-string (format nil "~a dgst -md5 ~a"
				 *whereis-openssl* file-name))
	 (result-string  (shell-command command-string :output :read-line
					:put put)))
    (when (regexp:match "=" result-string)
      (setq result-string (second (regexp:regexp-split " " result-string))))
    result-string))

(defun shell-mediawiki-farm-importdump (xchunk-name &key (put nil))
  "Importing xchunk into `xxwiki' database"
  (let* ((server         (file-name-to-server xchunk-name :put put))
	 (code-path      (merge-pathnames
		 (parse-namestring *whereis-directory-mediawiki-maintenance*)
		 (parse-namestring *whereis-file-mediawiki-farm-importdump*)))
	 (command-string (concatenate 'string
			       (format nil "~a ~a ~a ~a ~a ~a"
				       *whereis-timeout*
				       *mirror-timeout-sec-importdump*
				       *whereis-php*
				       (namestring code-path)
				       xchunk-name
				       server)
			       (when (null put)
				 (format nil
					 " > ~a"
					 *whereis-file-dev-null*)))))
    (shell-command command-string :put put)))

(defun shell-mediawiki-farm-update (wiki &key (put nil))
  "Updating wiki database to current MediaWiki schema"
  (let* ((server         (wiki-to-server wiki :put put))
	 (code-path (merge-pathnames
	       (parse-namestring *whereis-directory-mediawiki-maintenance*)
	       (parse-namestring *whereis-file-mediawiki-farm-update*)))
         (command-string (concatenate 'string
			       (format nil
				       "~a ~a ~a --quick" 
				       *whereis-php*
				       (namestring code-path)
				       server)
			       (when (null put)
				 (format nil 
					 " > ~a" 
					 *whereis-file-dev-null*)))))
    (shell-command command-string :put put)))

(defun shell-elasticsearch-delete-for-wiki (wiki &key (put nil))
  "Deleting `elasticsearch' server indices for given wiki"
  ;;
  ;; Design note:
  ;;
  ;; (shell)$ curl -XDELETE 'localhost:9200/simplewiki_content_first?pretty' 2>&1
  ;; {
  ;;   "acknowledged" : true
  ;; }
  ;; (shell)$ curl -XDELETE 'localhost:9200/simplewiki_general_first?pretty' 2>&1
  ;; {
  ;;   "acknowledged" : true
  ;; }
  ;; (shell)$ curl -XDELETE 'localhost:9200/mw_cirrus_versions/version/simplewiki_content?pretty' 2>&1
  ;; (shell)$ curl -XDELETE 'localhost:9200/mw_cirrus_versions/version/simplewiki_general?pretty' 2>&1
  ;;
  (let* ((message          (_ "elasticsearch indices deleted for"))
	 (command-string-0 (format nil "~a -XDELETE '~a:9200/~a_content_first?pretty' 2>&1"
				   *whereis-curl*
				   *mirror-host-name-elasticsearch*
				   wiki))
	 (result-0         (shell-command command-string-0 :output :read-lines
					  :put put))
	 (lines-0          (loop
			    for line in result-0
			    when (and (regexp:match "acknowledged" line)
				      (regexp:match "true"         line))
			    collect line))
	 (command-string-1 (format nil "~a -XDELETE '~a:9200/~a_general_first?pretty' 2>&1"
				   *whereis-curl*
				   *mirror-host-name-elasticsearch*
				   wiki))
	 (result-1         (shell-command command-string-1 :output :read-lines
					  :put put))
	 (lines-1          (loop
			    for line in result-1
			    when (and (regexp:match "acknowledged" line)
				      (regexp:match "true"         line))
			    collect line))
	 (command-string-2 (format nil "~a -XDELETE '~a:9200/mw_cirrus_versions/version/~a_content?pretty' 2>&1"
				   *whereis-curl*
				   *mirror-host-name-elasticsearch*
				   wiki))
	 (result-2         (shell-command command-string-2 :output :read-lines
					  :put put))
	 (lines-2          (loop
			    for line in result-2
			    when (and (regexp:match "found"        line)
				      (regexp:match "true"         line))
			    collect line))
	 (command-string-3 (format nil "~a -XDELETE '~a:9200/mw_cirrus_versions/version/~a_general?pretty' 2>&1"
				   *whereis-curl*
				   *mirror-host-name-elasticsearch*
				   wiki))
	 (result-3         (shell-command command-string-3 :output :read-lines
					  :put put))
	 (lines-3          (loop
			    for line in result-3
			    when (and (regexp:match "found"        line)
				      (regexp:match "true"         line))
			    collect line))
	 (deleted-p        (and (not (zerop (length lines-0)))
				(not (zerop (length lines-1)))
				(not (zerop (length lines-2)))
				(not (zerop (length lines-3))))))
    (put-message result-0 :put put)
    (put-message result-1 :put put)
    (put-message result-2 :put put)
    (put-message result-3 :put put)
    (if deleted-p
	(put-message-value-done message wiki :put t)
      (put-message-value-fail message wiki))
    deleted-p))

(defun shell-elasticsearch-indices-for-wiki (wiki &key (put nil))
  "Determining if `elasticsearch' server has indices for given wiki"
  ;;
  ;; Design note:
  ;;
  ;; (shell)$ curl 'localhost:9200/_cat/indices?v' 2>&1
  ;; epoch      timestamp cluster       status node.total node.data shards pri relo init unassign
  ;; 1411771441 18:44:01  elasticsearch green           1         1      9   9    0    0        0
  ;;
  (let* ((message        (_ "elasticsearch has indices for"))
	 (command-string (format nil "~a '~a:9200/_cat/indices?v' 2>&1"
				*whereis-curl*
				*mirror-host-name-elasticsearch*))
	 (result         (shell-command command-string :output :read-lines
					:put put))
	 (lines          (loop
			  for line in result
			  when (regexp:match wiki line)
			  collect line))
	 (indices-p      (not (zerop (length lines)))))
    (put-message result :put put)
    (if indices-p
	(put-message-value-done message wiki :put t)
      (put-message-value-fail message wiki))
    indices-p))

(defun shell-elasticsearch-ping (&key (put nil))
  "Asserting `elasticsearch' is alive"
  ;;
  ;; Design note:
  ;;
  ;; Success looks like:
  ;;
  ;; (shell)$ curl 'localhost:9200/_cat/health?v' 2>&1
  ;; epoch      timestamp cluster       status node.total node.data shards pri relo init unassign
  ;; 1411771441 18:44:01  elasticsearch green           1         1      9   9    0    0        0
  ;;
  ;; Failure looks like:
  ;;
  ;; (shell)$ curl 'localhost:9200/_cat/health?v' 2>&1
  ;; curl: (7) Failed to connect to localhost port 9200: Connection refused
  ;;
  ;; curl          return status:   0 -> server is running; 7-> not
  ;; shell-command return status: nil -> server is running; 7-> not
  ;;
  (let* ((command-string (format nil "~a '~a:9200/_cat/health?v' > ~a 2>&1"
				*whereis-curl*
				*mirror-host-name-elasticsearch*
				*whereis-file-dev-null*)))
    (shell-command command-string :put put)))

(defun shell-elasticsearch-status (&key (put nil))
  "Determining status of `elasticsearch' server"
  ;;
  ;; Design note:
  ;;
  ;; (shell)$ curl 'localhost:9200/_cat/health?v' 2>&1
  ;; epoch      timestamp cluster       status node.total node.data shards pri relo init unassign
  ;; 1411771441 18:44:01  elasticsearch green           1         1      9   9    0    0        0
  ;;
  (let* ((command-string (format nil "~a '~a:9200/_cat/health?v' 2>&1"
				*whereis-curl*
				*mirror-host-name-elasticsearch*))
	 (result         (shell-command command-string :output :read-lines
					:put put))
	 (line           (loop
			  for line in result
			  when (regexp:match "elasticsearch" line)
			  return line))
	 (status         nil))
    (when (not (null line))
      (setq status (cond ((regexp:match "green"  line) :green )
			 ((regexp:match "yellow" line) :yellow)
			 ((regexp:match "red"    line) :red   )
			 (t nil))))
    (put-message result :put put)
    (put-message-value (_ "elasticsearch server status") status :put put)
    status))

(defun shell-mediawiki-cirrussearch-forcesearchindex-skiplinks (wiki
								&key (put nil))
  "Populating search index for elasticsearch"
  (let* ((server         (wiki-to-server wiki :put put))
	 (code-path (merge-pathnames
	       (parse-namestring
		*whereis-directory-mediawiki-extensions-cirrussearch-maintenance*)
	       (parse-namestring
		*whereis-file-mediawiki-extensions-cirrussearch-forcesearchindex*)))
         (command-string (concatenate 'string
			       (format nil
				       "~a ~a ~a --wiki ~a --skipLinks --indexOnSkip --queue"
				       *whereis-php*
				       (namestring code-path)
				       server
				       wiki)
			       (when (null put)
				 (format nil
					 " > ~a"
					 *whereis-file-dev-null*)))))
    (shell-command command-string :put put)))

(defun shell-mediawiki-cirrussearch-forcesearchindex-skipparse (wiki
							     &key (put nil))
  "Populating search index for elasticsearch"
  (let* ((server         (wiki-to-server wiki :put put))
	 (code-path (merge-pathnames
	       (parse-namestring
		*whereis-directory-mediawiki-extensions-cirrussearch-maintenance*)
	       (parse-namestring
		*whereis-file-mediawiki-extensions-cirrussearch-forcesearchindex*)))
         (command-string (concatenate 'string
			       (format nil
				       "~a ~a ~a --wiki ~a --skipParse --queue"
				       *whereis-php*
				       (namestring code-path)
				       server
				       wiki)
			       (when (null put)
				 (format nil
					 " > ~a"
					 *whereis-file-dev-null*)))))
    (shell-command command-string :put put)))

(defun shell-mediawiki-cirrussearch-updatesearchindexconfig (wiki
							     &key (put nil))
  "Creating search index for elasticsearch"
  (let* ((server         (wiki-to-server wiki :put put))
	 (code-path (merge-pathnames
	       (parse-namestring
		*whereis-directory-mediawiki-extensions-cirrussearch-maintenance*)
	       (parse-namestring
		*whereis-file-mediawiki-extensions-cirrussearch-updatesearchindexconfig*)))
         (command-string (concatenate 'string
			       (format nil
				       "~a ~a ~a --wiki ~a"
				       *whereis-php*
				       (namestring code-path)
				       server
				       wiki)
			       (when (null put)
				 (format nil
					 " > ~a"
					 *whereis-file-dev-null*)))))
    (shell-command command-string :put put)))

(defun shell-mediawiki-localization-update (&key (put nil))
  "Updating localization of messages for MediaWiki"
  (let* ((code-path (merge-pathnames
	       (parse-namestring
		*whereis-directory-mediawiki-extensions-localisation-update*)
	       (parse-namestring
		*whereis-file-mediawiki-extensions-localisation-update*)))
         (command-string (concatenate 'string
			       (format nil
				       "~a ~a"
				       *whereis-php*
				       (namestring code-path))
			       (when (null put)
				 (format nil
					 " > ~a"
					 *whereis-file-dev-null*)))))
    (shell-command command-string :put put)))

(defun shell-mediawiki-rebuild-titlekey (wiki &key (page-id-start 0) (put nil))
  "Rebuilding `titlekey' database table for wiki"
  (let* ((server         (wiki-to-server wiki :put put))
	 (code-path (merge-pathnames
	       (parse-namestring
		*whereis-directory-mediawiki-extensions-titlekey*)
	       (parse-namestring
		*whereis-file-mediawiki-extensions-titlekey-rebuild-titlekey*)))
         (command-string (concatenate 'string
			       (format nil
				       "~a ~a ~a --start ~d"
				       *whereis-php*
				       (namestring code-path)
				       server
				       page-id-start)
			       (when (null put)
				 (format nil
					 " > ~a"
					 *whereis-file-dev-null*)))))
    (shell-command command-string :put put)))

(defun shell-mwxml2sql (xchunk-name-stub xchunk-name-text file-name-template
					 &key (put nil))
  "Converting `xchunk' to set of `sql' files (for `page', `revision', and `text')"
  (let ((command-string (concatenate 'string 
			      (format nil "~a " *whereis-mwxml2sql*)
			      ;;"--verbose "
			      (format nil "--stubs ~a "     xchunk-name-stub)
			      (format nil "--text ~a "      xchunk-name-text)
			      (format nil "--mysqlfile ~a " file-name-template)
			      (format nil "--mediawiki ~a" *mediawiki-version*)
			      " 2>&1")))
    (shell-command command-string :output :read-lines :put put)))

(defun shell-mysql-and-return-stream (arguments &key (put nil))
  "Querying MySQL database"
  (let ((s (ext:run-program *whereis-mysql*
			    :arguments arguments
			    :output :stream)))
  (if (null s)
      (put-message-value-fail-and-abort (_ "mysql query") arguments)
    s)))

(defun shell-mysql-install-db (&key (put nil))
  "Installing MySQL Data Directory"
  (let ((command-string (format nil "~a --user=mysql"
				*whereis-mysql-install-db*)))
    (shell-command command-string :put put)
    (shell-chown-dir *whereis-directory-mysql-datadir* 
		     :owner "mysql:mysql" :put put)))

(defun shell-mysql-load-dump-file (db-name path-name &key (put nil))
  "Loading SQL dump file into database"
  (let* ((file-name      (namestring path-name))
	 (file-ext       (file-name-to-extension file-name :put put))
	 (command-string (concatenate 'string
	    (case file-ext
		  (:bz2 (format nil "~a ~a |" *whereis-bzcat* file-name))
		  (:gz  (format nil "~a ~a |" *whereis-zcat*  file-name))
		  (:sql (format nil "~a ~a |" *whereis-cat*   file-name))
		  (t    (put-message-value-fail-and-abort
			 (_ "unknown file extension") file-name)))
	    (format nil "~a " *whereis-mysql*)
	    (format nil "--host=~a " *db-server*)
	    (format nil "--user=~a " *db-wikiadmin-user*)
	    (format nil "--password=~a " *db-wikiadmin-password*)
	    (format nil "--database=~a " db-name)
	    "2>&1")))
    (shell-command command-string :output :read-line :put put)))

(defun shell-mysql-restart (&key (put nil))
  "Restarting the `mysqld' server"
  (let ((path-name (merge-pathnames
		    (parse-namestring *whereis-directory-mysql-datadir*)
		    (parse-namestring *whereis-file-mysql-log-file*))))
    (sleep-while #'shell-invoke-rc.d "mysql" "stop") ; return `nil' success
    (shell-remove-file path-name             :put put)
    (sleep-while #'shell-invoke-rc.d "mysql" "start") ; return `nil' success
    ))

(defun shell-mysql-tzinfo-to-sql-load-database (&key (put nil))
  "Loading time zone info into database"
  (let ((command-string (format nil "~a ~a 2>/dev/null | ~a ~a"
				*whereis-mysql-tzinfo-to-sql* 
				*whereis-zoneinfo*
				*whereis-mysql*
				(concatenate 'string 
		     (format nil "--host=~a "     *db-server*)
		     (format nil "--user=~a "     *db-debian-user*)
		     (format nil "--password=~a " *db-debian-password*)
		                 "--database=mysql"))))
    (shell-command command-string :put put)))

(defun shell-mysqladmin-ping (&key (put nil))
  "Asserting `mysqld' is alive"
  ;;
  ;; Design note:
  ;;
  ;; (shell)$ mysqladmin --defaults-file=/etc/mysql/debian.cnf ping
  ;;
  ;; mysqladmin    return status:   0 -> server is running; 1-> not
  ;; shell-command return status: nil -> server is running; 1-> not
  ;;
  (let* ((path-name (namestring
		     (merge-pathnames
		      (parse-namestring *whereis-directory-mysql-config*)
		      (parse-namestring *whereis-file-mysql-config-debian*))))
	 (command-string (format nil "~a --defaults-file=~a ping > ~a 2>&1"
				*whereis-mysqladmin* path-name
				*whereis-file-dev-null*)))
    (shell-command command-string :put put)))

(defun shell-mysqldump-to-file (database-name file-path &key (put nil))
  "Dumping MySQL database to file"
  (let ((command-string (concatenate 'string
			   (format nil "~a " *whereis-mysqldump*)
			   (format nil "--host=~a "     *db-server*)
			   (format nil "--user=~a "     *db-wikiadmin-user*)
			   (format nil "--password=~a " *db-wikiadmin-password*)
			   database-name)))
    (shell-command command-string :output file-path
		   :if-output-exists :overwrite :put put)))

(defun shell-printf-md5sum (string &key (put nil))
  "Computing md5sum of a string"
  ;;
  ;; Design note:
  ;;
  ;; String may neither have spaces nor characters with special
  ;; meaning to `shell' (e.g. backquote, dollar, parentheses, etc.)
  ;; unless escaped with a backslash.
  ;;
  ;; 1) bad    Maria_Callas_(La_Traviata).jpg   
  ;; 2) good   Maria_Callas_\(La_Traviata\).jpg
  ;;
  (let* ((command-string (format nil "~a printf %s ~a | ~a dgst -md5"
				 *whereis-env*
				 string
				 *whereis-openssl*))
	 (result-string  (shell-command command-string :output :read-line
	                                :put put)))
    ;; Implementations of openssl differ.  Have seen two output formats:
    ;; 1) 00001111222233334444555566667777
    ;; 2) (stdin)= 00001111222233334444555566667777
    (when (regexp:match "=" result-string)
      (setq result-string (second (regexp:regexp-split " " result-string))))
    (debug-message-value (_ "md5sum trimmed") result-string)
    result-string))

(defun shell-invoke-rc.d (service action &key (put nil))
  "Invoking run-time service"
  (let ((command-string (format nil "~a ~a ~a" 
				*whereis-invoke-rc.d*
				service action)))
    (shell-command command-string :put nil)))

(defun shell-remove-directory (dir-name &key (put nil))
  "Removing directory"
  (let ((command-string (format nil "~a --recursive --force ~a"
				*whereis-rm* dir-name)))
    (shell-command command-string :put nil)))

(defun shell-remove-file (file-name &key (put nil))
  "Removing file"
  (let ((command-string (format nil "~a --force ~a" *whereis-rm* file-name)))
    (shell-command command-string :put nil)))

(defun shell-remove-all-working-files (wiki &key (put t))
  "Removing all working files"
  (when (ext:probe-directory *whereis-directory-mediawiki-images*)
    ;; clean up .../images/ directory
    (put-message-start (_ "cd to images directory")                 :put put)
    (ext:cd *whereis-directory-mediawiki-images*)
    (put-message-value-done (_ "cd to images directory") (ext:cd)   :put put)
    (shell-remove-file "*log"                                       :put put)
    (shell-remove-file (format nil "~a*" wiki)                      :put put))
  (when (ext:probe-directory *whereis-directory-wpmirror-working*)
    ;; clean up .../images/wp-mirror/ directory
    (put-message-start (_ "cd to working directory")                :put put)
    (ext:cd *whereis-directory-wpmirror-working*)
    (put-message-value-done (_ "cd to working directory") (ext:cd)  :put put)
    (shell-remove-file (format nil "~a*" wiki)                      :put put))
  t)

(defun shell-script (file-name &key (put nil))
  "Running a shell script"
  (let ((command-string (format nil "./~a" file-name)))
    (shell-command command-string :put put)))

(defun shell-show-engine-innodb-status-grep (pattern &key (put nil))
  "Grepping `show engine innodb status' output"
  (let ((command-string (concatenate 'string
			  (format nil "~a " *whereis-mysql*)
			  (format nil "--host=~a "     *db-server*)
			  (format nil "--user=~a "     *db-wikiadmin-user*)
			  (format nil "--password=~a " *db-wikiadmin-password*)
			  "--execute=\"SHOW ENGINE INNODB STATUS\\G\" "
			  "| "
			  (format nil "~a ~s" *whereis-grep* pattern))))
    (shell-command command-string :output :read-line :put put)))

(defun shell-split-sdump-to-schunk (file-name &key (put nil))
  "Splitting `sdump' file into `schunk's"
  ;;
  ;; Design note:
  ;;
  ;; (shell) time zgrep 'INSERT INTO' commonswiki-yyyymmdd-image.sql.gz |
  ;;              replace 'INSERT INTO' 'REPLACE INTO' |
  ;;              split --lines=10 --numeric-suffixes --suffix-length=9
  ;; --filter='(echo "START TRANSACTION;"; cat -;echo "COMMIT;") | gzip > $FILE'
  ;;                    - commonswiki-yyyymmdd-image.sql.gz
  ;;
  ;; Generates files named:
  ;;
  ;;   commonswiki-yyyymmdd-image.sql.gz000000000
  ;;   commonswiki-yyyymmdd-image.sql.gz000000001 ...
  ;;
  (let ((command-string (concatenate 'string
                          (format nil "~a 'INSERT INTO' ~a | "
				  *whereis-zgrep* file-name)
			  (format nil "~a 'INSERT INTO' 'REPLACE INTO' | "
				  *whereis-replace*)
			  (format nil "~a --lines=~a "
				  *whereis-split* *mirror-schunk-page-count*)
			  "--numeric-suffixes --suffix-length=9 "
			  "--filter='(echo \"START TRANSACTION;\"; cat -; echo \"COMMIT;\") | gzip > $FILE' "
			  (format nil "- ~a" file-name))))
    (shell-command command-string :put nil)))

(defun shell-split-xdump-to-xchunk (path-name xchunk-page-count
					      &key (put nil))
  "Splitting `xdump' file into `xchunk's"
  ;;
  ;; Design note:
  ;;
  ;; (shell) time bzcat simplewiki-yyyymmdd-pages-articles.xml.bz2 | \
  ;;              gawk --lint 'BEGIN{fmt="%09d"; # format index pipes \
  ;;                           headp=1;    # is header (initially true) \
  ;;                           ipage=0;    # index pages \
  ;;                           ipipe=0;    # index pipes \
  ;;                           j=0;k=0;    # index header lines \
  ;;                           npage=10000;# pages per pipe \
  ;;                           pipe="bzip2 > /dev/null"; \
  ;;                           tail="</mediawiki>";} \
  ;;                   # create new file every 10,000 pages
  ;;                   /^  <page>/{headp=0; \
  ;;                               if(ipage%npage==0){ \
  ;;                                  # put tail, close old pipe \
  ;;                                  print tail | pipe; \
  ;;                                  close(pipe); \
  ;;                                  # create new pipe, put header \
  ;;                                  pipe="bzip2 > simplewiki-yyyymmdd-pages-articles.xml.bz2"sprintf(fmt,ipipe); \
  ;;                                  for(k=0;k<j;k++){ \
  ;;                                     print head[k] | pipe;} \
  ;;                                  ipipe++;} \
  ;;                               ipage++;} \
  ;;                   # header - save lines prior to first <page> tag \
  ;;                   headp==1{head[j]=$$0;j++} \
  ;;                   # print all lines to a file \
  ;;                   {print | pipe;} \
  ;;                   END{close(pipe)}' -
  ;;
  ;; Generates files named:
  ;;
  ;;   simplewiki-yyyymmdd-pages-articles.xml.bz2000000000
  ;;   simplewiki-yyyymmdd-pages-articles.xml.bz2000000001 ...
  ;;
  (let* ((file-name       (namestring path-name))
	 (language-code   (file-name-to-language-code file-name :put put))
	 (wiki            (file-name-to-wiki          file-name :put put))
	 (file-ext        (file-name-to-extension     file-name :put put))
	 (func-compress   (case file-ext
				(:bz2 *whereis-bzip2*)
				(:gz  *whereis-gzip* )
				(t (put-message-value-fail-and-abort
				    (_ "unknown file extension") file-name))))
	 (func-decompress (case file-ext
				(:bz2 *whereis-bzcat*)
				(:gz  *whereis-zcat* )
				(t (put-message-value-fail-and-abort
				    (_ "unknown file extension") file-name))))
	 (command-string (concatenate 'string
	    (format nil "~a ~a |" func-decompress file-name)
	    (format nil "~a --lint " *whereis-gawk*)
	    ;; 1) pattern(BEGIN)-action
	    "'BEGIN{fmt=\"%09d\";headp=1;ipage=0;ipipe=0;j=0;k=0;"
	    (format nil "npage=~d;" xchunk-page-count)
	    (format nil "pipe=\"~a > /dev/null\";" func-compress)
	    "tail=\"</mediawiki>\";}"
	    ;; 2) pattern(regular expression)-action
	    "/^  <page>/{headp=0;"
	    "if(ipage%npage==0){print tail | pipe;close(pipe);"
	    (format nil "pipe=\"~a > ~a\"sprintf(fmt,ipipe);"
		    func-compress file-name)
	    "for(k=0;k<j;k++){print head[k] | pipe;}"
	    "ipipe++;}ipage++;}"
	    ;; 3) pattern(relational expression)-action
	    "headp==1{head[j]=$0;j++}"
	    ;; 4) pattern(missing)-action
	    "{print | pipe;}"
	    ;; 5) pattern(END)-action
	    "END{close(pipe)}' -")))
    (shell-command command-string :put nil)))

(defun shell-zcat-replace (file-name-in replace-pattern	replace-string
					file-name-out &key (put nil))
  "Replacing strings in given file"
  ;;
  ;; Design note:
  ;;
  ;; (shell) zcat simplewiki-yyyymmdd-p000000000-c000001000-page.sql-1.23.gz |
  ;;         replace 'INSERT' 'REPLACE' | gzip >
  ;;         simplewiki-yyyymmdd-page-p000000000-c000001000.sql.gz
  ;;
  (let ((command-string (concatenate 'string
                          (format nil "~a ~a | "
				  *whereis-zcat* file-name-in)
			  (format nil "~a '~a' '~a' | "
				  *whereis-replace*
				  replace-pattern replace-string)
			  (format nil "~a > ~a "
				  *whereis-gzip* file-name-out))))
    (shell-command command-string :put nil)))


;;;;--------------------------------------------------------------------------+
;;;; Miscellaneous utilities                                                  |
;;;;--------------------------------------------------------------------------+


(defun sleep-while (f &rest args)
  "Sleeping until earlier of time-out or function returns false"
  (put-message-value (_ "sleep while true or time-out")
		     *mirror-sleep-timeout-sec-max*)
  (loop
   for time-step fixnum in *mirror-sleep-list*
   sum time-step into time-cum fixnum
   do (put-message (format nil "sleep for ~6d sec, wake at ~6d sec"
			   time-step time-cum))
      (sleep time-step)
   always (and (apply f args)                                  ; <-- apply
	       (< time-cum *mirror-sleep-timeout-sec-max*))))

(defun sleep-until (f &rest args)
  "Sleeping until earlier of time-out or function returns true"
  (put-message-value (_ "sleep until true or time-out")
		     *mirror-sleep-timeout-sec-max*)
  (loop
   for time-step fixnum in *mirror-sleep-list*
   sum time-step into time-cum fixnum
   do (put-message (format nil "sleep for ~6d sec, wake at ~6d sec"
			   time-step time-cum))
      (sleep time-step)
   thereis (or (apply f args)                                  ; <-- apply
	       (> time-cum *mirror-sleep-timeout-sec-max*))))

(defun sleep-until-zero (f &rest args)
  "Sleeping until earlier of time-out or function returns zero"
  (put-message-value (_ "sleep until zero or time-out")
		     *mirror-sleep-timeout-sec-max*)
  (loop
   for time-step fixnum in *mirror-sleep-list*
   sum time-step into time-cum fixnum
   do (put-message (format nil "sleep for ~6d sec, wake at ~6d sec"
			   time-step time-cum))
      (sleep time-step)
   thereis (or (zerop (apply f args))                          ; <-- apply
	       (> time-cum *mirror-sleep-timeout-sec-max*))))


;;;;--------------------------------------------------------------------------+
;;;; Database utilities:                                                      |
;;;;   Debian packages cl-sql, cl-mysql, cl-uffi seem broken.                 |
;;;;   So 'query-database-*' are written using 'ext:run-program'.             |
;;;;--------------------------------------------------------------------------+


(defun grep-first (file-name pattern &key (put nil))
  "Grepping text file for first line matching pattern or nil"
  (first (shell-cat-grep file-name pattern :put put)))

(defun grep-first-non-comment (file-name pattern &key (put nil))
  "Grepping text file for first non-comment line matching pattern or nil"
  (with-open-file (f file-name
		     :direction :input
		     :if-does-not-exist nil)
    (when (streamp f)
      (do ((l (read-line f nil 'eof) (read-line f nil 'eof)))
	  ((eq l 'eof) nil)
	(unless (regexp:match "^[#;]" l)
	  (when (regexp:match pattern l)
	    (return l)))))))

(defun grep-last (file-name pattern &key (put nil))
  "Grepping text file for last line matching pattern or nil"
  (first (last (shell-cat-grep file-name pattern :put put))))

(defun grep-last-non-comment (file-name pattern &key (put nil))
  "Grepping text file for first non-comment line matching pattern or nil"
  (with-open-file (f file-name
		     :direction :input
		     :if-does-not-exist nil)
    (when (streamp f)
      (do ((l (read-line f nil 'eof) (read-line f nil 'eof))
	   (result nil))
	  ((eq l 'eof) result)
	(unless (regexp:match "^[#;]" l)
	  (when (regexp:match pattern l)
	    (setq result l)))))))

(defun query-database-and-return-stream (sql-string
					 &key
					 (user     *db-wikiadmin-user*)
					 (database nil)
					 (put      nil))
  "Submitting SQL query, returning a stream containing the results"
  (debug-message-start (_ "query database return stream"))
  (debug-message sql-string)
  (let* ((password  (cond
		     ((eql user *db-debian-user*)    *db-debian-password*)
		     ((eql user *db-root-user*)      *db-root-password*)
		     ((eql user *db-wikiadmin-user*) *db-wikiadmin-password*)
		     ((eql user *db-wikiuser-user*)  *db-wikiuser-password*)
		     (t nil)))
	 (arguments (list
		     (concatenate 'string "--host="     *db-server*)
		     (concatenate 'string "--user="     user)
		     (concatenate 'string "--password=" password)
		     ;; --batch separates cells with Tab, rows with Newline
		     ;; we need Tabs for reliable parsing
		     "--batch"
		     "--skip-column-names"
		     ;; --raw means no escaping special characters
		     "--raw"
		     (concatenate 'string "--database=" database)
		     (concatenate 'string "--execute="  sql-string))))
    (debug-message (format nil "~a" (append (list "mysql") arguments)))
    (shell-mysql-and-return-stream arguments :put put)))

(defun query-database-and-return-list-of-strings (sql-string
				&key
				(user     *db-wikiadmin-user*)
				(database nil)
				(put      nil))
  "Submitting SQL query, returning a list of strings where each string is a row in the table"
  (let ((table-list nil))
    (with-open-stream (s (query-database-and-return-stream sql-string
							   :user     user
							   :database database
							   :put      put))
      (do ((l (read-line s nil 'eof) (read-line s nil 'eof)))
	  ((eq l 'eof) (nreverse table-list))
	(push l table-list)))))

(defun query-database-and-return-list-of-lists (sql-string
				&key
				(user     *db-wikiadmin-user*)
				(database nil)
				(put      nil))
  "Submitting SQL query, returning a list of lists of objects, where each object is an element in the table"
  ;; this will misalign if there are NULL valued table elements not in
  ;; the last column (that is, NULL is not parsed)
  (let ((table-list nil)
	(result     nil))
    (with-open-stream (s (query-database-and-return-stream sql-string
							   :user     user
							   :database database
							   :put      put))
      (debug-message (_ "return stream") :put put)
      ;; --batch option separates cells with Tab, ends line with Newline
      (regexp:with-loop-split (row s (string #\Tab))
        ;; row is bound to a list of substrings split from one line of s
	(debug-message-value (_ "row") row :put put)
	(loop
	  with new-row = nil
	  for cell    in row
	  as  elem    = (if (or (regexp:match ":" cell) ; do not read packages
				(>= (length cell) 32))  ; md5sum is not number
			    cell
			  (with-input-from-string (s cell) (read s nil 'eof)))
	  do (setq new-row (cond ((numberp elem) (push elem new-row))
				 ((symbolp elem) (push cell new-row))
				 (t              (push cell new-row))))
	     (debug-message-value (_ "new-row") new-row :put put)
	  finally (setq table-list (push (nreverse new-row) table-list)))))
    (debug-message-value (_ "table-list") table-list :put put)
    (setq result (nreverse table-list))
    (debug-message-value (_ "return-list-of-lists") result :put put)
    result))

(defun sql-alter-table-add-column (database-name table-name column-spec-list
						 &key (put nil))
  "Adding column(s) to given database table"
  ;;
  ;; Design note:
  ;;
  ;; Column specification list looks like:
  ;;
  ;; ("`disk_usage_mysql_datadir` BIGINT UNSIGNED NOT NULL DEFAULT 0"
  ;;  "`disk_usage_working_dir` BIGINT UNSIGNED NOT NULL DEFAULT 0"
  ;;  "`partition_free_images` BIGINT UNSIGNED NOT NULL DEFAULT 0"
  ;;  "`partition_free_innodb` BIGINT UNSIGNED NOT NULL DEFAULT 0")
  ;;
  (let* ((alter-table-0 (format nil "ALTER TABLE `~a`.`~a` ~{ADD COLUMN ~a, ~}"
				database-name table-name column-spec-list))
	 ;; replace trailing comma with semicolon
	 (alter-table-1 (format nil "~a;" (subseq
					   alter-table-0 0
					   (- (length alter-table-0) 2)))))
    (query-database-and-return-stream alter-table-1
				      :user     *db-wikiadmin-user*
				      :database nil
				      :put      put)))

(defun sql-alter-table-add-key (database-name table-name key-spec-list
					      &key (put nil))
  "Adding key(s) to given database table"
  ;;
  ;; Design note:
  ;;
  ;; Key specification list is scraped from `SHOW CREATE TABLE' and
  ;; looks like:
  ;;
  ;; ("  KEY `img_usertext_timestamp` (`img_user_text`, `img_timestamp`)"
  ;;  "  KEY `img_size` (`img_size`)"
  ;;  "  KEY `img_timestamp` (`img_timestamp`)"
  ;;  "  KEY `img_sha1` (`img_sha1`)")
  ;;
  (let* ((alter-table-0 (format nil "ALTER TABLE `~a`.`~a` ~{ADD ~a, ~}"
				database-name table-name key-spec-list))
	 ;; replace trailing comma with semicolon
	 (alter-table-1 (format nil "~a;" (subseq
					   alter-table-0 0
					   (- (length alter-table-0) 2)))))
    (query-database-and-return-stream alter-table-1
				      :user     *db-wikiadmin-user*
				      :database nil
				      :put      put)))

(defun sql-alter-table-drop-key (database-name table-name key-name-list
					       &key (put nil))
  "Dropping key(s) from given database table"
  ;;
  ;; Design note:
  ;;
  ;; `Key-name-list' is scraped from `SHOW CREATE TABLE' and looks like:
  ;;
  ;; ("img_usertext_timestamp" "img_size" "img_timestamp" "img_sha1")
  ;;
  (let* ((alter-table-0 (format nil "ALTER TABLE `~a`.`~a` ~{DROP KEY `~a`, ~}"
				database-name table-name key-name-list))
	 ;; replace trailing comma with semicolon
	 (alter-table-1 (format nil "~a;" (subseq
					   alter-table-0 0
					   (- (length alter-table-0) 2)))))
    (query-database-and-return-stream alter-table-1
				      :user     *db-wikiadmin-user*
				      :database nil
				      :put      put)))

(defun sql-alter-table-modify-column (database-name table-name column-spec-list
						    &key (put nil))
  "Modifying column(s) to given database table"
  ;;
  ;; Design note:
  ;;
  ;; Column specification list looks like:
  ;;
  ;; ("`type` ENUM('database','table','checksum','xdump','xml','xchunk','sdump','sql','schunk','dchunk','xincr','idump','ichunk','images','error') NOT NULL DEFAULT 'error'")
  ;;
  (let* ((alter-table-0 (format nil "ALTER TABLE `~a`.`~a` ~{MODIFY COLUMN ~a, ~}"
				database-name table-name column-spec-list))
	 ;; replace trailing comma with semicolon
	 (alter-table-1 (format nil "~a;" (subseq
					   alter-table-0 0
					   (- (length alter-table-0) 2)))))
    (query-database-and-return-stream alter-table-1
				      :user     *db-wikiadmin-user*
				      :database nil
				      :put      put)))

(defun sql-alter-table-row-format (database-name table-name
						 row-format key-block-size
						 &key (put nil))
  "Altering row format for given database table"
  (let ((alter-table (concatenate 'string
		       (format nil "ALTER TABLE `~a`.`~a` "
			       database-name table-name)
		       (format nil "ROW_FORMAT=~a " row-format)
		       (format nil "KEY_BLOCK_SIZE=~d;" key-block-size))))
    (query-database-and-return-stream alter-table
				      :user     *db-wikiadmin-user*
				      :database nil
				      :put      put)))

(defun sql-create-database (database-name &key (put nil))
  "Creating a database"
  (let ((create-database (format nil "CREATE DATABASE `~a`;" database-name)))
    (query-database-and-return-stream create-database
				      :user     *db-wikiadmin-user*
				      :database nil
				      :put      put)))

(defun sql-create-table-file (&key (put nil))
  "Creating table `file'"
  (let ((create-table    (concatenate 'string
        "CREATE TABLE IF NOT EXISTS `wpmirror`.`file` ("
	"`timestamp`      TIMESTAMP DEFAULT CURRENT_TIMESTAMP "
	"ON UPDATE CURRENT_TIMESTAMP, "
	"`project`        VARCHAR(20) NOT NULL DEFAULT 'error', " ; `wikipedia'
	"`wiki`           VARCHAR(30) NOT NULL DEFAULT 'error', " ; `simplewiki'
	"`language_code`  VARCHAR(20) NOT NULL DEFAULT 'error', " ; `simple'
	"`date`           VARCHAR(8)  NOT NULL DEFAULT 'error', " ; `20111007'
	"`name`           VARCHAR(80) NOT NULL DEFAULT 'error', "
	"`size`           BIGINT UNSIGNED NOT NULL DEFAULT 0, "   ; [0-18e18]
	"`md5sum`         VARCHAR(32) NOT NULL DEFAULT 'error', "
	"`type`           ENUM('database','table','checksum','xdump','xml','xchunk','sdump','sql','schunk','dchunk','xincr','idump','ichunk','images','error') "
	"NOT NULL DEFAULT 'error', "
	"`state`          ENUM('start','created','valid','pending','done','fail','error') "
        "NOT NULL DEFAULT 'error', "
	"`page`           INTEGER UNSIGNED NOT NULL DEFAULT 0, "
	"`pages`          INTEGER UNSIGNED NOT NULL DEFAULT 0, " ; pages
	"`images`         INTEGER UNSIGNED NOT NULL DEFAULT 0, " ; images
	"`updates`        INTEGER UNSIGNED NOT NULL DEFAULT 0, "
	"`semaphore`      INTEGER UNSIGNED NOT NULL DEFAULT 1, " ; [0-1]
	"PRIMARY KEY (`name`)) "
        "ENGINE=InnoDB;")))                                    ; ACID compliant
    (query-database-and-return-stream create-table
				      :user     *db-wikiadmin-user*
				      :database *db-wpmirror-name*
				      :put      put)))

(defun sql-create-table-priority (&key (put nil))
  "Creating table `priority'"
  (let ((create-table    (concatenate 'string
        (format nil "CREATE TABLE IF NOT EXISTS `~a`.`priority` ("
		*db-wpmirror-name*)
	"`id`             INTEGER UNSIGNED NOT NULL AUTO_INCREMENT, "
	"`type`           ENUM('database','table','checksum','xdump','xml','xchunk','sdump','sql','schunk','dchunk','idump','ichunk','images','error') "
	"NOT NULL DEFAULT 'error', "
	"`state`          ENUM('start','created','valid','pending','done','fail','error') "
        "NOT NULL DEFAULT 'error', "
	"`concurrent`     INTEGER UNSIGNED NOT NULL DEFAULT 0, "
	"`image`          INTEGER UNSIGNED NOT NULL DEFAULT 0, "
	"`commons`        INTEGER UNSIGNED NOT NULL DEFAULT 0, "
	"PRIMARY KEY (`id`)) "
        "ENGINE=InnoDB;")))
    (query-database-and-return-stream create-table
				      :user     *db-wikiadmin-user*
				      :database *db-wpmirror-name*
				      :put      put)))

(defun sql-create-table-time (&key (put nil))
  "Creating table `time'"
  (let ((create-table    (concatenate 'string
          (format nil "CREATE TABLE IF NOT EXISTS `~a`.`time` ("
	    *db-wpmirror-name*)
	  "`id` INTEGER UNSIGNED NOT NULL AUTO_INCREMENT, "
	  "`timestamp`  TIMESTAMP DEFAULT CURRENT_TIMESTAMP "
	  "ON UPDATE  CURRENT_TIMESTAMP, "
	  "`run` INTEGER UNSIGNED NOT NULL DEFAULT 0, "
	  "`function_name` VARCHAR(80) NOT NULL DEFAULT 'error', "
	  "`file_name` VARCHAR(80) NOT NULL DEFAULT 'error', "
	  "`real_time` BIGINT UNSIGNED NOT NULL DEFAULT 0, "  ; [0-18e18]
	  "`disk_usage_mysql_datadir` BIGINT UNSIGNED NOT NULL DEFAULT 0, "
	  "`disk_usage_working_dir` BIGINT UNSIGNED NOT NULL DEFAULT 0, "
	  "`partition_free_images` BIGINT UNSIGNED NOT NULL DEFAULT 0, "
	  "`partition_free_innodb` BIGINT UNSIGNED NOT NULL DEFAULT 0, "
	  "PRIMARY KEY (`id`)) "
	  "ENGINE=InnoDB; "                                 ; ACID compliant
	  (format nil "INSERT INTO `~a`.`time` " *db-wpmirror-name*)
	  "(`run`,`function_name`,`file_name`,`real_time`,"
	  "`disk_usage_mysql_datadir`,`disk_usage_working_dir`,"
	  "`partition_free_images`,`partition_free_innodb`) "
	  "VALUES "
	  (format nil "(0,'sql-create-table-time','nil',0,~d,~d,~d,~d);"
		  (shell-du-mysql-datadir       :put put)
		  (shell-du-wpmirror-working    :put put)
		  (system-partition-free-images :put put)
		  (system-partition-free-innodb :put put)))))
    (query-database-and-return-stream create-table
				      :user     *db-wikiadmin-user*
				      :database *db-wpmirror-name*
				      :put      put)))

(defun sql-create-user (user password &key (put nil))
  "Creating DBMS accounts with no privileges granted"
  (let ((create-user (concatenate 'string
			  (format nil "CREATE USER '~a'@'localhost' " user)
			  (format nil "IDENTIFIED BY '~a';" password))))
    (query-database-and-return-stream create-user
				      :user     *db-debian-user*
				      :database *db-type*
				      :put      put)))

(defun sql-create-user-debian    (password &key (put nil))
  "Creating DBMS account for `debian-sys-maint', no privileges granted"
  (let ((create-user (concatenate 'string
				  "CREATE USER 'debian-sys-maint'@'localhost' "
				  (format nil "IDENTIFIED BY '~a';" password))))
    (query-database-and-return-stream create-user
				      :user     *db-root-user*
				      :database *db-type*
				      :put      put)))

(defun sql-delete-from-objectcache (wiki &key (put nil))
  "Deleting a few rows from `objectcache' table in given wiki"
  ;;
  ;; Design note:
  ;;
  ;; We should routinely delete a few rows from the `objectcache'
  ;; table to avoid an accumulation of millions of lines, followed by
  ;; an hour long delay (which causes other queries to time out) when
  ;; `MediaWiki' purges the cache.
  ;;
  (put-message-start (_ "delete from `objectcache' limit ") :put put)
  (let* ((object-count (sql-select-count-wiki-objectcache wiki :put put))
	 (delete-from  (format nil "DELETE FROM `~a`.`objectcache` LIMIT ~d;"
			       (wiki-to-database-name wiki :put put)
			       *mirror-objectcache-delete-limit*))
	 (threshold-p  (> object-count *mirror-objectcache-threshold*))
	 (result       nil))
    (if threshold-p
	(put-message-value (_ "objectcache above threshold")
			   (format nil "~d > ~d, deleting ~d"
				   object-count
				   *mirror-objectcache-threshold*
				   *mirror-objectcache-delete-limit*)
			   :put put)
      (put-message-value (_ "objectcache below threshold")
			   (format nil "~d <= ~d, skipping"
				   object-count
				   *mirror-objectcache-threshold*)
			   :put put))
    (when threshold-p
	(setq result (query-database-and-return-list-of-strings
		      delete-from
		      :database nil
		      :put put)))
    (put-message-value-done (_ "delete from `objectcache' limit ") result
			    :put put)
    result))

(defun sql-delete-language-code (language-code &key (put nil))
  "Deleting all rows of given language-code from `wpmirror.file' table"
  (let ((delete-from (format nil "DELETE FROM `~a`.`file` WHERE `language_code`='~a';"
			     *db-wpmirror-name* language-code)))
    (query-database-and-return-list-of-strings delete-from
					       :user     *db-debian-user*
					       :put      put)))

(defun sql-delete-orphan-from-page (wiki &key (put nil))
  "Deleting all orphan rows from `page' table of given wiki"
  ;;
  ;; Design note:
  ;;
  ;; By orphan page, we mean a row in the `page' table for which there
  ;; is no corresponding row in the `revision' table.
  ;;
  (let* ((database-name (wiki-to-database-name wiki :put put))
	 (delete-from   (format nil "DELETE QUICK `~a`.`page` FROM `~a`.`page` LEFT JOIN `~a`.`revision` ON `page_id`=`rev_page` WHERE `rev_page` IS NULL;" 
				database-name database-name database-name)))
    (query-database-and-return-list-of-strings delete-from
					       :user     *db-debian-user*
					       :put      put)))

(defun sql-delete-orphan-from-revision (wiki &key (put nil))
  "Deleting all orphan rows from `revision' table of given wiki"
  ;;
  ;; Design note:
  ;;
  ;; By orphan revision, we mean a row in the `revision' table for
  ;; which there is no corresponding row in the `text' table.
  ;;
  (let* ((database-name (wiki-to-database-name wiki :put put))
	 (delete-from   (format nil "DELETE QUICK `~a`.`revision` FROM `~a`.`revision` LEFT JOIN `~a`.`text` ON `rev_text_id`=`old_id` WHERE `old_id` IS NULL;"
				database-name database-name database-name)))
    (query-database-and-return-list-of-strings delete-from
					       :user     *db-debian-user*
					       :put      put)))

(defun sql-delete-orphan-from-text (wiki &key (put nil))
  "Deleting all orphan rows from `text' table of given wiki"
  ;;
  ;; Design note:
  ;;
  ;; By orphan text, we mean a row in the `text' table for which there
  ;; is no corresponding row in the `revision' table.
  ;;
  ;; Caveat.  This query is too slow. It procedes by linear search
  ;; because `rev_text_id' is not indexed.
  ;;
  (let* ((database-name (wiki-to-database-name wiki :put put))
	 (delete-from   (format nil "DELETE `~a`.`text` FROM `~a`.`text` LEFT JOIN `~a`.`revision` ON `old_id`=`rev_text_id` WHERE `rev_text_id` IS NULL;"
				database-name database-name database-name)))
    (query-database-and-return-list-of-strings delete-from
					       :user     *db-debian-user*
					       :put      put)))

(defun sql-delete-superseded-from-revision (wiki &key (put nil))
  "Deleting all superseded rows from `revision' table of given wiki"
  ;;
  ;; Design note:
  ;;
  ;; o There is a many-to-one relation between the `revision' and
  ;; `page' tables. The `rev_page' field is the (undeclared) foreign
  ;; key on primary key `page_id'.
  ;;
  ;; o The `page_latest' field contains `rev_id' of the most recent
  ;; revision.
  ;;
  ;; o A `rev_id' is considered superseded if no `page_latest' refers
  ;; to it.
  ;;
  ;; Caveat. This query is too slow (about 20ks for `simplewiki'). It
  ;; procedes by linear search because `page_latest' is not indexed.
  ;;
  (let* ((database-name (wiki-to-database-name wiki :put put))
	 (delete-from   (format nil "DELETE QUICK `~a`.`revision` FROM `~a`.`revision` LEFT JOIN `~a`.`page` ON `rev_id`=`page_latest` WHERE `page_latest` IS NULL;"
				database-name database-name database-name)))
    (query-database-and-return-list-of-strings delete-from
					       :user     *db-debian-user*
					       :put      put)))

(defun sql-delete-wiki (wiki &key (put nil))
  "Deleting all rows of given wiki from `wpmirror.file' table"
  (let ((delete-from (format nil "DELETE FROM `~a`.`file` WHERE `wiki`='~a';"
			     *db-wpmirror-name* wiki)))
    (query-database-and-return-list-of-strings delete-from
					       :user     *db-debian-user*
					       :put      put)))

(defun sql-drop-database (database-name &key (put nil))
  "Dropping database"
  (let ((drop-database  (format nil "DROP DATABASE `~a`;" database-name)))
    (query-database-and-return-stream drop-database
				      :user *db-debian-user*
				      :database nil
				      :put put)))

(defun sql-drop-database-table (database-name table-name &key (put nil))
  "Dropping table in database"
  (let ((drop-table  (format nil "DROP TABLE IF EXISTS ~a;" table-name)))
    (query-database-and-return-list-of-strings drop-table
					       :user *db-wikiadmin-user*
					       :database database-name
					       :put put)))

(defun sql-drop-user (user &key (put nil))
  "Dropping DBMS user account"
  (let ((drop-user (format nil "DROP USER '~a'@'localhost';" user)))
    (query-database-and-return-stream drop-user
				      :user     *db-debian-user*
				      :database *db-type*
				      :put      put)))

(defun sql-encrypt (str &key (put nil))
  "Encrypting a string"
  (let* ((select (format nil "SELECT ENCRYPT('~a');" str))
	 (result (query-database-and-return-list-of-strings select
						    :user *db-debian-user*
						    :put put)))
    (first result)))

(defun sql-encrypt-current-timestamp (&key (put nil))
  "Encrypting current timestamp (to generate a pseudo-random password)"
  (let* ((select "SELECT ENCRYPT(CURRENT_TIMESTAMP());")
	 (result (query-database-and-return-list-of-strings select
						    :user *db-debian-user*
						    :put put)))
    (first result)))

(defun sql-grant-all-to-debian (&key (put nil))
  "Granting all permissions to *db-debian-user*"
  (let ((grant (format nil "GRANT ALL PRIVILEGES ON *.* TO '~a'@'~a' WITH GRANT OPTION; FLUSH PRIVILEGES;"
		       *db-debian-user* *db-server*)))
    (query-database-and-return-stream grant
				      :user     *db-root-user*
				      :database nil
				      :put      put)))

(defun sql-grant-global-to-wikiadmin (&key (put nil))
  "Granting some global privileges to `wikiadmin'"
  ;;
  ;; Design note:
  ;;
  ;; Monitor mode needs the global PROCESS privilege to run
  ;;
  ;; mysql-shell> SHOW ENGINE INNODB STATUS\G
  ;;
  (let ((grant (format nil "GRANT PROCESS ON *.* TO '~a'@'~a'; FLUSH PRIVILEGES;"
		       *db-wikiadmin-user* *db-server*)))
    (query-database-and-return-stream grant
				      :user     *db-debian-user*
				      :database nil
				      :put      put)))

(defun sql-grant-all-on-database-to-wikiadmin (database-name &key (put nil))
  "Granting permissions on given database to *db-wikiadmin-user*"
  ;; error if db-name contains a `-' (e.g. `zh-classical')
  (let ((grant (format nil "GRANT ALL PRIVILEGES ON `~a`.* TO '~a'@'~a'; FLUSH PRIVILEGES;"
		       database-name *db-wikiadmin-user* *db-server*)))
    (query-database-and-return-stream grant
				      :user     *db-debian-user*
				      :database nil
				      :put      put)))

(defun sql-grant-siud-on-database-to-wikiuser (database-name &key (put nil))
  "Granting permissions on given database to *db-wikiuser-user*"
  ;; error if db-name contains a `-' (e.g. `zh-classical')
  (let ((grant (concatenate 'string "GRANT SELECT,INSERT,UPDATE,DELETE "
			    (format nil "ON `~a`.* " database-name)
			    (format nil "TO '~a'@'~a'; FLUSH PRIVILEGES;"
				    *db-wikiuser-user* *db-server*))))
    (query-database-and-return-stream grant
				      :user     *db-debian-user*
				      :database nil
				      :put      put)))

(defun sql-insert-file (project wiki language-code
				file-date file-name file-type
				&key (size nil) (md5sum nil)
				(page nil) (pages nil) (images nil)
				(put nil))
  "Inserting new file"
  (let* ((insert-values (concatenate 'string
	   (format nil "INSERT INTO `~a`.`file` " *db-wpmirror-name*)
	   "(`project`,`wiki`,`language_code`,`date`,`name`,`size`,`md5sum`,`type`,`state`,`page`,`pages`,`images`,`updates`,`semaphore`) "
	   "VALUES "
	   (format nil "('~a','~a','~a','~a','~a',~d,'~a','~a','~a',~d,~d,~d,~d,~d) "
		   project
		   wiki
		   language-code
		   file-date
		   file-name
		   (if (null size) 0 size)               ; size
		   (if (null md5sum) "0" md5sum)         ; md5sum
		   file-type                             ;
		   "start"                               ;
		   (if (null page) 0 page)               ; page start
		   (if (null pages) 0 pages)             ; pages
		   (if (null images) 0 images)           ; images
		   0                                     ; updates
		   1)                                    ; semaphore
	   "ON DUPLICATE KEY UPDATE "
	   (format nil "type='~a', " file-type)
	   (format nil "state='start';")))
	 (result (query-database-and-return-stream insert-values
						   :user *db-wikiadmin-user*
						   :put  put)))
    (put-message insert-values :put put)
    t))

(defun sql-insert-image (md5sum &key (state nil) (put nil))
  "Inserting new image record"
  (let* ((insert-values (concatenate 'string
	   (format nil "INSERT INTO `~a`.`image` " *db-wpmirror-name*)
	   "(`img_md5sum`,`img_state`) "
	   "VALUES "
	   (format nil "('~a','~a');"
		   md5sum
		   (if (null state) "created" state))))
	 (result (query-database-and-return-stream insert-values :put put)))
    (put-message insert-values :put put)
    t))

(defun sql-insert-priority (&key (put nil))
  "Inserting records from  *type-state-priority*"
  (let ((insert (make-array '(0) :element-type 'base-char
			         :fill-pointer 0 :adjustable t)))
    (with-output-to-string (s insert)
      (format s "TRUNCATE `~a`.`priority`; " *db-wpmirror-name*)
      (format s "INSERT INTO `~a`.`priority`" *db-wpmirror-name*)
      (format s  "(`type`,`state`,`concurrent`,`image`,`commons`) ")
      (format s "VALUES ")
      (loop
       for (type state concurrent image commons) in *type-state-priority*
       as  i from 1
       do (format s "('~a','~a',~d,~d,~d)"
		  type state
		  (if (null concurrent) 0 1)
		  (if (null image)      0 1)
		  (if (null commons)    0 1))
	  (if (eql i (length *type-state-priority*))
	      (format s ";")
	    (format s ","))))
    (put-message insert :put put)
    (query-database-and-return-stream insert
				      :user     *db-wikiadmin-user*
				      :database nil
				      :put      put)))

(defun sql-insert-time (fsm-func fsm-file real-time-diff &key (put nil))
  "Inserting elapsed real time for given function and file"
  (let* ((insert-values (concatenate 'string
	   (format nil "INSERT INTO `~a`.`time` " *db-wpmirror-name*)
	   "(`run`,`function_name`,`file_name`,`real_time`,"
	   "`disk_usage_mysql_datadir`,`disk_usage_working_dir`,"
	   "`partition_free_images`,`partition_free_innodb`) "
	   "VALUES "
	   (format nil "(~d,'~a','~a',~d,~d,~d,~d,~d);"
		   *db-wpmirror-profile*
		   fsm-func fsm-file real-time-diff
		   (shell-du-mysql-datadir       :put put)
		   (shell-du-wpmirror-working    :put put)
		   (system-partition-free-images :put put)
		   (system-partition-free-innodb :put put))))
	 (result (query-database-and-return-stream insert-values :put put)))
    (put-message insert-values :put put)
    t))

(defun sql-load-data-infile (file-name &key (put nil))
  "Loading SQL data `infile' into database"
  (let* ((database-name (file-name-to-database-name file-name :put put))
	 (table-name    (third (regexp:regexp-split "-" file-name)))
	 (load-infile   (concatenate 'string
			  (format nil "LOAD DATA INFILE '~a~a' "
				  *whereis-directory-wpmirror-working*
				  file-name)
			  (format nil "REPLACE INTO TABLE `~a`.`~a` "
				  database-name table-name)
			  "FIELDS TERMINATED BY ',' "
			  "OPTIONALLY ENCLOSED BY "
			  (format nil "~c~c~c " #\" #\; #\")
			  "LINES TERMINATED BY '),(';"))
	 (result (query-database-and-return-stream load-infile
						   :user     *db-debian-user*
						   :database nil
						   :put      put)))
    (put-message load-infile :put put)
    result))

(defun sql-revoke-all-on-database-to-wikiadmin (database-name &key (put nil))
  "Revoking permissions to *db-wiki-admin* for given database"
  (let ((revoke (format nil "REVOKE ALL PRIVILEGES ON `~a`.* FROM '~a'@'~a';"
			database-name *db-wikiadmin-user* *db-server*)))
    (query-database-and-return-stream revoke
				      :user     *db-debian-user*
				      :database nil
				      :put      put)))

(defun sql-revoke-siud-on-database-to-wikiuser (database-name &key (put nil))
  "Revoking permissions on given database to *db-wikiuser-user*"
  ;; error if db-name contains a `-' (e.g. `zh-classical')
  (let ((revoke (format nil "REVOKE SELECT,INSERT,UPDATE,DELETE ON `~a`.* FROM '~a'@'~a';"
		       database-name *db-wikiuser-user* *db-server*)))
    (query-database-and-return-stream revoke
				      :user     *db-wikiadmin-user*
				      :database nil
				      :put      put)))

(defun sql-select-image (md5sum &key (put nil))
  "Determining if image-file is in `wpmirror.image'"
  (let* ((select (format nil "SELECT COUNT(*) FROM `~a`.`image` WHERE `img_md5sum`='~a';"
			 *db-wpmirror-name* md5sum))
	 (result (sql-select-numeric select :put put)))
    ;; return t if found, nil otherwise
    (> result 0)))

(defun sql-select-image-list-local (wiki d2 &key (put nil))
  "Listing `local-media' file names referenced by `wiki' in directory d2"
  ;;
  ;; Design note:
  ;;
  ;; Optimization. The simplest SQL statement runs too slowly:
  ;;
  ;; SELECT DISTINCT img_name FROM simplewiki.image,simplewiki.imagelinks
  ;; WHERE il_to=img_name AND MD5(img_name) LIKE '00%' ORDER BY img_name;
  ;;
  ;; This alternative produces the same result much faster (90% less time)
  ;;
  ;; SELECT img_name FROM simplewiki.image,
  ;;  (SELECT DISTINCT il_to FROM simplewiki.imagelinks) AS tmp
  ;; WHERE il_to=img_name AND MD5(il_to) LIKE '00%' ORDER BY img_name;
  ;;
  (let* ((select (concatenate 'string
	  "SELECT `img_name` "
	  (format nil "FROM `~a`.`image`," wiki)
	  (format nil "(SELECT DISTINCT il_to FROM `~a`.`imagelinks`) AS tmp " wiki)
	  "WHERE `il_to`=`img_name` "
	  (format nil "AND MD5(`il_to`) LIKE '~a%' " d2)
	  "ORDER BY `img_name` DESC;"))
	 (result (query-database-and-return-list-of-strings select :put put)))
    (debug-message select)
    (debug-message result)
    result))

(defun sql-select-image-list-remote (wiki d2 &key (put nil))
  "Listing `remote-media' file names referenced by `wiki' in directory d2"
  ;;
  ;; Design note:
  ;;
  ;; Optimization.  The simplest SQL statement takes over 1 hour:
  ;;
  ;; SELECT DISTINCT img_name FROM commonswiki.image,simplewiki.imagelinks
  ;; WHERE il_to=img_name AND MD5(img_name) LIKE '00%' ORDER BY img_name;
  ;;
  ;; This alternative produces the same result in 3 minutes (95% less time):
  ;;
  ;; SELECT img_name FROM commonswiki.image,
  ;;  (SELECT DISTINCT il_to FROM simplewiki.imagelinks) AS tmp
  ;; WHERE il_to=img_name AND MD5(il_to) LIKE '00%' ORDER BY img_name;
  ;;
  (let* ((select (concatenate 'string
          "SELECT `img_name` "
	  "FROM `commonswiki`.`image`,"
	  (format nil "(SELECT DISTINCT il_to FROM `~a`.`imagelinks`) AS tmp " wiki)
	  "WHERE `il_to`=`img_name` "
	  (format nil "AND MD5(`il_to`) LIKE '~a%' " d2)
	  "ORDER BY `img_name` DESC;"))
	 (result (query-database-and-return-list-of-strings select :put put)))
    (debug-message select)
    (debug-message result)
    result))

(defun sql-select-image-state (md5sum &key (put nil))
  "Determining if image-file is in `wpmirror.image'"
  (let* ((select (format nil "SELECT `img_state` FROM `~a`.`image` WHERE `img_md5sum`='~a';"
			 *db-wpmirror-name* md5sum)))
    (put-message select :put put)
    (first
     (first
      (query-database-and-return-list-of-lists select :put put)))))

(defun sql-select-language-code-list (&key (put nil))
  "Determining languages seen in `wpmirror.file'"
  (let* ((select (format nil "SELECT DISTINCT `language_code` FROM `~a`.`file`;"
			 *db-wpmirror-name*))
	 (result (query-database-and-return-list-of-strings select :put put)))
    (debug-message select)
    (debug-message result)
    result))

(defun sql-select-type-count (type &key (put nil))
  "Counting files of given type"
  (let ((select (format nil "SELECT COUNT(*) FROM `~a`.`file` WHERE `type`='~a';"
			*db-wpmirror-name* type)))
    (sql-select-numeric select :put put)))

(defun sql-select-type-progress (type &key (put nil))
  "Estimating progress [0,1] in processing files of given type"
  (let* ((weight (sql-select-type-weight type :put put))
	 (count  (sql-select-type-count  type :put put)))
    (if (zerop count)
	0
      (/ weight count))))

(defun sql-select-type-weight (type &key (put nil))
  "Estimating progress [0,N] in processing files of given type"
  (let ((select (concatenate 'string
			     "SELECT "
			     "SUM(IF(STRCMP(state,'created'),0,0.25)"
			     "  + IF(STRCMP(state,'valid')  ,0,0.50)"
			     "  + IF(STRCMP(state,'pending'),0,0.75)"
			     "  + IF(STRCMP(state,'fail')   ,0,1.00)"
			     "  + IF(STRCMP(state,'done')   ,0,1.00)) "
			     (format nil "FROM `~a`.`file` "
				     *db-wpmirror-name*)
			     (format nil "WHERE `type`='~a';" type))))
    (sql-select-numeric select :put put)))

(defun sql-select-wiki-list (&key (put nil))
  "Determining wikis seen in `wpmirror.file'"
  (let* ((select (format nil "SELECT DISTINCT `wiki` FROM `~a`.`file`;"
			 *db-wpmirror-name*))
	 (result (query-database-and-return-list-of-strings select :put put)))
    (debug-message select)
    (debug-message result)
    result))

(defun sql-select-wiki-list-for-language-code (language-code &key (put nil))
  "Determining wikis seen in `wpmirror.file' for given language code"
  (let* ((select (format nil "SELECT DISTINCT `wiki` FROM `~a`.`file` WHERE `language_code`='~a';"
			 *db-wpmirror-name* language-code))
	 (result (query-database-and-return-list-of-strings select :put put)))
    (debug-message select)
    (debug-message result)
    result))

(defun sql-select-wiki-list-for-project (project &key (put nil))
  "Determining wikis seen in `wpmirror.file' for given project"
  (let* ((select (format nil "SELECT DISTINCT `wiki` FROM `~a`.`file` WHERE `project`='~a';"
			 *db-wpmirror-name* project))
	 (result (query-database-and-return-list-of-strings select :put put)))
    (debug-message select)
    (debug-message result)
    result))

(defun sql-select-wiki-most-recent-date (wiki &key (put nil))
  "Determining most recent date for given wiki seen in `wpmirror.file'"
  (let* ((select (format nil "SELECT DISTINCT MAX(`date`) FROM `~a`.`file` WHERE `wiki`='~a';"
			 *db-wpmirror-name* wiki))
	 (result (query-database-and-return-list-of-strings select :put put)))
    (debug-message select)
    (debug-message result)
    (first result)))

(defun sql-select-wiki-type-file-name (wiki type &key (put nil))
  "Determining filename of given type for given wiki seen in `wpmirror.file'"
  (let* ((select (format nil "SELECT name FROM (select * from `~a`.`file` WHERE `wiki`='~a' AND `type`='~a' ORDER BY `date` DESC LIMIT 1) AS a;"
			 *db-wpmirror-name* wiki type))
	 (result (query-database-and-return-list-of-strings select :put put)))
    (debug-message select)
    (debug-message result)
    (first result)))

(defun sql-select-wiki-table-date (wiki &key (put nil))
  "Determining date of `table' for given wiki seen in `wpmirror.file'"
  (let ((file-name (sql-select-wiki-type-file-name wiki "table" :put put)))
    (sql-select-file-date file-name :put put)))

(defun sql-select-wiki-table-state (wiki &key (put nil))
  "Determining state of `table' for given wiki seen in `wpmirror.file'"
  (let ((file-name (sql-select-wiki-type-file-name wiki "table" :put put)))
    (sql-select-file-state file-name :put put)))

(defun sql-select-wiki-xdump-date (wiki &key (put nil))
  "Determining date of `xdump' for given wiki seen in `wpmirror.file'"
  (let ((file-name (sql-select-wiki-type-file-name wiki "xdump" :put put)))
    (sql-select-file-date file-name :put put)))

(defun sql-select-wiki-xdump-state (wiki &key (put nil))
  "Determining state of `xdump' for given wiki seen in `wpmirror.file'"
  (let ((file-name (sql-select-wiki-type-file-name wiki "xdump" :put put)))
    (sql-select-file-state file-name :put put)))

(defun sql-select-wiki-xincr-date (wiki &key (put nil))
  "Determining date of `xincr' for given wiki seen in `wpmirror.file'"
  (let ((file-name (sql-select-wiki-type-file-name wiki "xincr" :put put)))
    (sql-select-file-date file-name :put put)))

(defun sql-select-wiki-xincr-state (wiki &key (put nil))
  "Determining state of `xincr' for given wiki seen in `wpmirror.file'"
  (let ((file-name (sql-select-wiki-type-file-name wiki "xincr" :put put)))
    (sql-select-file-state file-name :put put)))

(defun sql-select-mysql-user (&key (put nil))
  "Selecting DBMS user accounts"
  (let* ((select "SELECT `host`,`user`,`password` FROM `mysql`.`user`;")
	 (result (query-database-and-return-list-of-lists select
							  :user *db-debian-user*
							  :put  put)))
    (put-message-start select :put put)
    (when result
      (dolist (row result nil)
	(put-message (format nil "~{~a ~}" row) :put put)))
    (put-message-done select :put put)))

(defun sql-select-numeric (select &key (put nil))
  "Returning a numeric value from a database query"
  (let ((result (query-database-and-return-list-of-lists select :put  put)))
    (put-message select :put put)
    (put-message result :put put)
    (cond ((null result) 0)
	  ((and (stringp (first (first result)))
		(string= (first (first result)) "NULL")) 0)
	  (t (first (first result))))))

(defun sql-select-count (wiki &key (type nil) (state nil)
			      (semaphore nil) (put nil))
  "Counting records in `wpmirror.file'"
  ;; we centralize code common to most `SELECT COUNT(*)' queries
  (let ((select (concatenate 'string
			     (format nil "SELECT COUNT(*) FROM `~a`.`file` "
				     *db-wpmirror-name*)
			     (format nil "WHERE `wiki`='~a' " wiki)
			     (unless (null type)
			       (format nil "AND `type`='~a' " type))
			     (unless (null state)
			       (format nil "AND `state`='~a' " state))
			     (unless (null semaphore)
			       (format nil "AND `semaphore`='~d' " semaphore))
			     ";")))
     (sql-select-numeric select :put put)))

(defun sql-select-count-file (wiki &key (put nil))
  "Counting records in `wpmirror.file' of given wiki"
  (sql-select-count wiki :put put))

(defun sql-select-count-ichunk (wiki &key (put nil))
  "Counting `ichunk's given wiki"
  (sql-select-count wiki :type "ichunk" :put put))

(defun sql-select-count-ichunk-done (wiki &key (put nil))
  "Counting `ichunk's that are done"
  (sql-select-count wiki :type "ichunk" :state "done" :put put))

(defun sql-select-count-ichunk-fail (wiki &key (put nil))
  "Counting `ichunk's that have failed"
  (sql-select-count wiki :type "ichunk" :state "fail" :put put))

(defun sql-select-count-ichunk-remaining (wiki &key (put nil))
  "Counting `ichunk's remaining to be processed"
  (- (sql-select-count-ichunk      wiki :put nil)
     (sql-select-count-ichunk-done wiki :put nil)
     (sql-select-count-ichunk-fail wiki :put nil)))

(defun sql-select-count-ichunk-running (wiki &key (put nil))
  "Counting `ichunks' that are currently being processed"
  (sql-select-count wiki :type "ichunk" :semaphore 0 :put put))

(defun sql-select-count-image-valid (&key (put nil))
  "Counting validated image-files in `wpmirror.image'"
  (let ((select (format nil "SELECT COUNT(*) FROM `~a`.`image` WHERE `img_state`='valid';"
			*db-wpmirror-name*)))
    (sql-select-numeric select :put put)))

(defun sql-select-count-images (wiki &key (put nil))
  "Counting `images' records"
  (sql-select-count wiki :type "images" :put put))

(defun sql-select-count-images-start (wiki &key (put nil))
  "Counting `images' records of state `start'"
  (sql-select-count wiki :type "images" :state "start" :put put))

(defun sql-select-count-images-created (wiki &key (put nil))
  "Counting `images' records of state `created'"
  (sql-select-count wiki :type "images" :state "created" :put put))

(defun sql-select-count-images-valid (wiki &key (put nil))
  "Counting `images' records of state `valid'"
  (sql-select-count wiki :type "images" :state "valid" :put put))

(defun sql-select-count-wiki-objectcache (wiki &key (put nil))
  "Counting `objectcache' records from wiki"
  (let ((select (format nil "SELECT COUNT(*) FROM `~a`.objectcache;"
			(wiki-to-database-name wiki :put put))))
    (sql-select-numeric select :put put)))

(defun sql-select-count-wiki-image (wiki &key (put nil))
  "Counting `image' records from wiki"
  (let ((select (format nil "SELECT COUNT(*) FROM `~a`.`image`;"
			(wiki-to-database-name wiki :put put))))
    (sql-select-numeric select :put put)))

(defun sql-select-count-wiki-page (wiki &key (put nil))
  "Counting `page' records from wiki"
  (let ((select (format nil "SELECT COUNT(*) FROM `~a`.`page`;"
			(wiki-to-database-name wiki :put put))))
    (sql-select-numeric select :put put)))

(defun sql-select-count-wiki-titlekey (wiki &key (put nil))
  "Counting `titlekey' records from wiki"
  (let ((select (format nil "SELECT COUNT(*) FROM `~a`.`titlekey`;"
			(wiki-to-database-name wiki :put put))))
    (sql-select-numeric select :put put)))

(defun sql-select-max-wiki-titlekey (wiki &key (put nil))
  "Selecting max index in `titlekey' table for wiki"
  (let ((select (format nil "SELECT MAX(tk_page) FROM `~a`.`titlekey`;"
			(wiki-to-database-name wiki :put put))))
    (sql-select-numeric select :put put)))

(defun sql-select-count-xchunk (wiki &key (put nil))
  "Counting xchunks"
  (sql-select-count wiki :type "xchunk" :put put))

(defun sql-select-count-xchunk-done (wiki &key (put nil))
  "Counting xchunks that are done"
  (sql-select-count wiki :type "xchunk" :state "done" :put put))

(defun sql-select-count-xchunk-fail (wiki &key (put nil))
  "Counting xchunks that have failed"
  (sql-select-count wiki :type "xchunk" :state "fail" :put put))

(defun sql-select-count-xchunk-remaining (wiki &key (put nil))
  "Counting `xchunk's remaining to be processed"
  (- (sql-select-count-xchunk      wiki :put nil)
     (sql-select-count-xchunk-done wiki :put nil)
     (sql-select-count-xchunk-fail wiki :put nil)))

(defun sql-select-count-xchunk-running (wiki &key (put nil))
  "Counting xchunks that are currently being processed"
  (sql-select-count wiki :type "xchunk" :semaphore 0 :put put))

(defun sql-select-idump-name-list (wiki &key (put nil))
  "Selecting list of idump file names of given wiki"
  (let* ((select (format nil "SELECT `name` FROM `~a`.`file` WHERE `type`='idump' and `wiki`='~a';"
			 *db-wpmirror-name* wiki))
	 (result (query-database-and-return-list-of-strings select :put put)))
    (put-message select :put put)
    result))

(defun sql-select-sdump-name (wiki &key (put nil))
  "Selecting list of sdump file names of given wiki"
  (let* ((select (format nil "SELECT `name` FROM `~a`.`file` WHERE `type`='sdump' and `wiki`='~a';"
			 *db-wpmirror-name* wiki))
	 (result (query-database-and-return-list-of-strings select :put put)))
    (put-message select :put put)
    (if (null result)
	nil
      (first result))))

(defun sql-select-xdump-name (wiki &key (put nil))
  "Selecting name of xdump file of given wiki"
  (let* ((select (format nil "SELECT `name` FROM `~a`.`file` WHERE `type`='xdump' and `wiki`='~a';"
			 *db-wpmirror-name* wiki))
	 (result (query-database-and-return-list-of-lists select :put put)))
    (put-message select :put put)
    (if (null result)
	nil
      (first (first result)))))

(defun sql-select-xdump-xml-name (wiki &key (put nil))
  "Selecting name of the `xml' file of a given wiki"
  (let* ((select (format nil "SELECT `name` FROM `~a`.`file` WHERE `type`='xml' and `wiki`='~a';"
			 *db-wpmirror-name* wiki))
	 (result (query-database-and-return-list-of-lists select :put put)))
    (put-message select :put put)
    (if (null result)
	nil
      (first (first result)))))

(defun sql-select-file (file-name &key (put nil))
  "Selecting file, returning list of lists"
  (let ((select (format nil "SELECT `project`,`wiki`,`language_code`,`date`,`name`,`size`,`md5sum`,`type`,`state`,`page`,`pages`,`images`,`updates`,`semaphore` FROM `~a`.`file` WHERE `name`='~a';"
			*db-wpmirror-name* file-name)))
    (put-message select :put put)
    (query-database-and-return-list-of-lists select :put put)))

(defun sql-select-file-all (file-name &key (put nil))
  "Selecting all, returning list of strings"
  (let ((select (format nil "SELECT * FROM `~a`.`file` WHERE `name`='~a';"
			*db-wpmirror-name* file-name)))
    (put-message select :put put)
    (query-database-and-return-list-of-lists select :put put)))

(defun sql-select-file-date (file-name &key (put nil))
  "Selecting file date, return string or nil"
  (let ((select (format nil "SELECT `date` FROM `~a`.`file` WHERE `name`='~a';"
			*db-wpmirror-name* file-name)))
    (first
     (query-database-and-return-list-of-strings select :put put))))

(defun sql-select-file-images (file-name &key (put nil))
  "Selecting images in file, return number or nil"
  (let ((select (format nil "SELECT `images` FROM `~a`.`file` WHERE `name`='~a';"
			*db-wpmirror-name* file-name)))
    (sql-select-numeric select :put put)))

(defun sql-select-file-language-code (file-name &key (put nil))
  "Selecting file language-code, return string or nil"
  (let ((select (format nil "SELECT `language_code` FROM `~a`.`file` WHERE `name`='~a';"
			*db-wpmirror-name* file-name)))
    (first
     (query-database-and-return-list-of-strings select :put put))))

(defun sql-select-file-md5sum (file-name &key (put nil))
  "Selecting file md5sum, return string or nil"
  (let ((select (format nil "SELECT `md5sum` FROM `~a`.`file` WHERE `name`='~a';"
			*db-wpmirror-name* file-name)))
    (first
     (query-database-and-return-list-of-strings select :put put))))

(defun sql-select-file-page (file-name &key (put nil))
  "Selecting file page, return number or nil"
  (let ((select (format nil "SELECT `page` FROM `~a`.`file` WHERE `name`='~a';"
			*db-wpmirror-name* file-name)))
    (sql-select-numeric select :put put)))

(defun sql-select-file-pages (file-name &key (put nil))
  "Selecting file pages in file, return number or nil"
  (let ((select (format nil "SELECT `pages` FROM `~a`.`file` WHERE `name`='~a';"
			*db-wpmirror-name* file-name)))
    (sql-select-numeric select :put put)))

(defun sql-select-file-project (file-name &key (put nil))
  "Selecting file project in file, return number or nil"
  (let ((select (format nil "SELECT `project` FROM `~a`.`file` WHERE `name`='~a';"
			*db-wpmirror-name* file-name)))
    (first
     (first
      (query-database-and-return-list-of-lists select :put put)))))

(defun sql-select-file-semaphore (file-name &key (put nil))
  "Selecting file semaphore, return 0, 1, or nil"
  (let ((select (format nil "SELECT `semaphore` FROM `~a`.`file` WHERE `name`='~a';"
			*db-wpmirror-name* file-name)))
    (sql-select-numeric select :put put)))

(defun sql-select-file-size (file-name &key (put nil))
  "Selecting file size, return number or nil"
  (let ((select (format nil "SELECT `size` FROM `~a`.`file` WHERE `name`='~a';"
			*db-wpmirror-name* file-name)))
    (sql-select-numeric select :put put)))

(defun sql-select-file-state (file-name &key (put nil))
  "Selecting file state, return string or nil"
  (let ((select (format nil "SELECT `state` FROM `~a`.`file` WHERE `name`='~a';"
			*db-wpmirror-name* file-name)))
    (first
     (first
      (query-database-and-return-list-of-lists select :put put)))))

(defun sql-select-file-type (file-name &key (put nil))
  "Selecting file type, return string or nil"
  (let ((select (format nil "SELECT `type` FROM `~a`.`file` WHERE `name`='~a';"
			*db-wpmirror-name* file-name)))
    (first
     (first
      (query-database-and-return-list-of-lists select :put put)))))

(defun sql-select-file-updates (file-name &key (put nil))
  "Selecting file updates, return number or nil"
  (let ((select (format nil "SELECT `updates` FROM `~a`.`file` WHERE `name`='~a';"
			*db-wpmirror-name* file-name)))
    (sql-select-numeric select :put put)))

(defun sql-select-file-wiki (file-name &key (put nil))
  "Selecting file wiki, return string or nil"
  (let ((select (format nil "SELECT `wiki` FROM `~a`.`file` WHERE `name`='~a';"
			*db-wpmirror-name* file-name)))
    (first
     (first
      (query-database-and-return-list-of-lists select :put put)))))

(defun sql-select-schema-count-innodb-trx (pattern &key (put nil))
  "Counting `innodb' transactions like given pattern"
  (let ((select (concatenate 'string
		  "SELECT COUNT(*) FROM `information_schema`.`innodb_trx` "
		  "WHERE `trx_query` "
		  (format nil "LIKE '%~a%';" pattern))))
    (sql-select-numeric select :put put)))

(defun sql-select-schema-count-tables (database-name &key (put nil))
  "Counting tables in a database"
  (let ((select (format nil (concatenate 'string
		   "SELECT COUNT(*) FROM `information_schema`.`tables` "
		   (format nil "WHERE `table_schema`='~a';" database-name)))))
    (sql-select-numeric select :put put)))

(defun sql-select-schema-tables-table-name (database-name &key (put nil))
  "Listing table names in a database"
  (let* ((select (format nil (concatenate 'string
		   "SELECT `table_name` FROM `information_schema`.`tables` "
		   (format nil "WHERE `table_schema`='~a';" database-name))))
	 (result (query-database-and-return-list-of-strings select
						 :user *db-debian-user*
						 :put put)))
    (put-message result :put put)
    result))

(defun sql-select-schema-tables-table-rows (database-name table-name &key (put nil))
  "Estimating number of rows in a database table"
  (let ((select (format nil (concatenate 'string
		   "SELECT `table_rows` FROM `information_schema`.`tables` "
		   (format nil "WHERE `table_schema`='~a' " database-name)
		   (format nil "AND   `table_name`='~a';"   table-name)))))
    (sql-select-numeric select :put put)))

(defun sql-select-schema-tables-row-format (database-name table-name
							 &key (put nil))
  "Determining row format of table (i.e. if it is compressed)"
  (let* ((select (concatenate 'string
		   "SELECT `row_format` FROM `information_schema`.`tables` "
		   (format nil "WHERE `table_schema`='~a' " database-name)
		   (format nil "AND `table_name`='~a';" table-name)))
         (result (query-database-and-return-list-of-lists select :put put)))
    (put-message select :put put)
    (if (null result)
        nil
      (first (first result)))))

(defun sql-select-sum-images-images (wiki &key (put nil))
  "Counting images in `images' records"
  (let ((select (format nil "SELECT SUM(`images`) FROM `~a`.`file` WHERE `wiki`='~a' AND `type`='images';"
			*db-wpmirror-name* wiki)))
    (sql-select-numeric select :put put)))

(defun sql-select-sum-images-pages (wiki &key (put nil))
  "Counting validated images in `images' records"
  (let ((select (format nil "SELECT SUM(`pages`) FROM `~a`.`file` WHERE `wiki`='~a' AND `type`='images';"
			*db-wpmirror-name* wiki)))
    (sql-select-numeric select :put put)))

(defun sql-select-time-disk-col-list (&key (put nil))
  "Selecting HDD related field names from `wpmirror.time' table"
  (let* ((column-name-list (sql-show-column-name-list *db-wpmirror-name* "time"
						      :put put))
	 (result           (loop
			    with len = 9
			    for column-name in column-name-list
			    when (and
				  (>= (length column-name) len)
				  (or
				   (string= column-name "disk_usag" :end1 len)
				   (string= column-name "partition" :end1 len)))
			    collect column-name)))
    (put-message result :put put)
    result))

(defun sql-select-time-disk-min-max-list (run &key (put nil))
  "Selecting disk usage data for given run from `wpmirror.time' table"
  (let* ((disk-col-name-list (sql-select-time-disk-col-list :put put))
	 (select             (make-array '(0) :element-type 'base-char
					      :fill-pointer 0 :adjustable t))
	 (result             nil))
    (with-output-to-string (s select)
      (loop
       initially (format s "SELECT ")
       for col-name in disk-col-name-list
       as  i from 1
       do (format s "MIN(~a),MAX(~a)" col-name col-name)
          (when (< i (length disk-col-name-list))
	    (format s ","))
       finally (format s " FROM `~a`.`~a` WHERE `run`=~d;"
		       *db-wpmirror-name* "time" run)))
    (put-message select :put put)
    (setq result (first
		  (query-database-and-return-list-of-lists select
						  :user *db-debian-user*
						  :put put)))
    (put-message result :put put)
    result))

(defun sql-select-time-sum-list (run &key (put nil))
  "Selecting real time data for given run from `wpmirror.time' table"
  (let* ((select (concatenate 'string
	   "SELECT `function_name`,SUM(`real_time`) "
	   (format nil "FROM `~a`.`time` " *db-wpmirror-name*)
	   (format nil "WHERE `run`=~d AND `function_name` LIKE 'fsm%' " run)
	   "GROUP BY `function_name` "
	   "UNION "
	   "SELECT `function_name`,`real_time` "
	   (format nil "FROM `~a`.`time` " *db-wpmirror-name*)
	   (format nil "WHERE `run`=~d AND `function_name` LIKE '%TOTAL' " run)
	   "GROUP BY `function_name`;"))
	 (result (query-database-and-return-list-of-lists select
							  :user *db-debian-user*
							  :put put)))
    (put-message result :put put)
    result))

(defun sql-select-time-fun-list (&key (put nil))
  "Selecting function names from `wpmirror.time' table"
  (let* ((select  (concatenate 'string
	   "SELECT DISTINCT `function_name`,SUM(`real_time`) "
	   (format nil "FROM `~a`.`time` " *db-wpmirror-name*)
	   "WHERE `function_name` LIKE 'fsm%' "
	   "GROUP BY `function_name` "
	   "UNION "
	   "SELECT `function_name`,SUM(`real_time`) "
	   (format nil "FROM `~a`.`time` " *db-wpmirror-name*)
	   "WHERE `function_name` LIKE '%TOTAL' "
           "GROUP BY `function_name`;"
	   ))
	 (result-0 (query-database-and-return-list-of-lists select
							  :user *db-debian-user*
							  :put put))
	 (result-1 (mapcar #'car result-0)))
    (put-message-value result-0 result-1 :put put)
    result-1))

(defun sql-select-time-run-list (n &key (put nil))
  "Selecting most recent `n' run numbers from `wpmirror.time' table"
  (let* ((select  (concatenate 'string
	   (format nil "SELECT DISTINCT `run` FROM `~a`.`time` " *db-wpmirror-name*)
	   (format nil "WHERE `run`>0 ORDER BY `run` DESC LIMIT ~d;" n)))
	 (result-0 (query-database-and-return-list-of-lists select
							:user *db-debian-user*
							:put put))
	 (result-1 (mapcar #'car result-0)))
    (put-message-value result-0 result-1 :put put)
    result-1))

(defun sql-select-time-run-max (&key (put nil))
  "Selecting `MAX(run)' from `wpmirror.time' table"
  (let ((select (format nil "SELECT MAX(`run`) FROM `~a`.`time`;"
			*db-wpmirror-name*)))
    (sql-select-numeric select :put put)))

(defun sql-select-time-zone-name (time-zone-name &key (put nil))
  "Selecting `time_zone_id' from `mysql.time_zone_name' table for given zone"
  (let* ((select (concatenate 'string
			      "SELECT `name` FROM `mysql`.`time_zone_name` "
			      (format nil "WHERE `name`='~a';" time-zone-name)))
	 (result (query-database-and-return-list-of-strings select
						    :user *db-debian-user*
						    :put put))
	 (name-found (first result)))
    (put-message-value (_"time-zone-name found") name-found :put put)
    name-found))

(defun sql-select-next-file (&key (put nil))
  "Selecting next file for processing by the finite state machine"
  ;; Each file has a semaphore to assure Isolation (the `I' in ACID)
  (let* ((message          (_ "selecting next file for processing"))
	 (message-select   (_ "sql-select-next-file select"))
	 (message-result   (_ "sql-select-next-file result"))
	 (message-file     (_ "sql-select-next-file file  "))
	 ;; processing order:
	 ;;  1) wiki ASC - process a wiki completely before starting next wiki
	 ;;  2) id   ASC - select highest priority file (for given wiki)
	 ;;  3) name ASC - process files alphabetically (for given wiki,id)
	 ;;                except that the `text' table should be done first
	 (select-text (concatenate 'string
	       "SELECT `name` "
	       (format nil "FROM `~a`.`file`,`~a`.`priority` "
		       *db-wpmirror-name* *db-wpmirror-name*)
	       "WHERE `file`.`type`=`priority`.`type` "
	       "AND   `file`.`state`=`priority`.`state` "
	       "AND   `name` LIKE '%text%' "         ; <--- `text' table only
	       (unless (eql *main-mode* :first-mirror)
		 "AND `concurrent`=1 ")
	       (unless *mirror-image-download-p*
		 "AND `image`=1 ")
	       (unless (mirror-commonswiki-p :put put)
		 "AND (`wiki`<>'commonswiki' OR `commons`=1) ")
	       "AND `semaphore`=1 "                  ; <--- free
	       "ORDER BY `wiki`,`id`,`name` "        ; <--- priority
	       "LIMIT 1 "
	       "FOR UPDATE "))                       ; <--- set IX lock on row
	 (select-no-text (concatenate 'string
	       "SELECT `name` "
	       (format nil "FROM `~a`.`file`,`~a`.`priority` "
		       *db-wpmirror-name* *db-wpmirror-name*)
	       "WHERE `file`.`type`=`priority`.`type` "
	       "AND   `file`.`state`=`priority`.`state` "
	       "AND   `name` NOT LIKE '%text%' "     ; <--- no `text' table
	       (unless (eql *main-mode* :first-mirror)
		 "AND `concurrent`=1 ")
	       (unless *mirror-image-download-p*
		 "AND `image`=1 ")
	       (unless (mirror-commonswiki-p :put put)
		 "AND (`wiki`<>'commonswiki' OR `commons`=1) ")
	       "AND `semaphore`=1 "                  ; <--- free
	       "ORDER BY `wiki`,`id`,`name` "        ; <--- priority
	       "LIMIT 1 "
	       "FOR UPDATE "))                       ; <--- set IX lock on row
	 (select (concatenate 'string
	       "START TRANSACTION; "                 ; <--- atomic
	       "SET @name = ("
	       (format nil "SELECT `name` FROM `~a`.`file` WHERE name="
		       *db-wpmirror-name*)
	       (format nil "(~a) UNION (~a) "
		       select-text select-no-text)
	       "LIMIT 1); "
	       (format nil "UPDATE `~a`.`file` SET `semaphore`=0 "
		       *db-wpmirror-name*)           ; <--- locked
 	       "WHERE `name`=@name "
	       "LIMIT 1; "
 	       "SELECT @name; "
	       "COMMIT;"))                           ; <--- atomic
	 (result      (query-database-and-return-list-of-lists select :put put))
	 (file-name   (first (first result))))
    (put-timestamp-message-start      message   :put put)
    (put-message-value message-select select    :put put)
    (put-message-value message-result result    :put put)
    (put-message-value message-file   file-name :put put)
    ;; notify of grab lock
    (if (or (string= file-name "NULL") (null file-name))
	(progn
	  (put-message (_ "no file ready for processing") :put put)
	  (setq file-name nil))
      (progn
	(put-message (format nil "~a" file-name) :put put)
	(put-message-value (_ "grab lock: set semaphore to")
			   (sql-select-file-semaphore file-name) :put put)
	(put-timestamp-message-done message :put put)))
    file-name))

(defun sql-select-ichunk-wip (wiki &key (put nil))
  "Selecting ichunk in progess (if any)"
  (let* ((select (format nil "SELECT `name` FROM `~a`.`file` WHERE `wiki`='~a' AND `type`='ichunk' AND `state`='valid';"
			 *db-wpmirror-name* wiki))
	 (result (query-database-and-return-list-of-strings select :put put)))
    (if (null result)
	(put-message-value (_ "no ichunks in progress") result :put put)
      (put-message-value (_ "ichunks in progress") (cdr result) :put put))
    (cdr result)))

(defun sql-select-xchunk-wip (wiki &key (put nil))
  "Selecting xchunk in progess (if any)"
  (let* ((select (format nil "SELECT `name` FROM `~a`.`file` WHERE `wiki`='~a' AND `type`='xchunk' AND `state`='valid';"
			 *db-wpmirror-name* wiki))
	 (result (query-database-and-return-list-of-strings select :put put)))
    (if (null result)
	(put-message-value (_ "no xchunks in progress") result :put put)
      (put-message-value (_ "xchunks in progress") (cdr result) :put put))
    (cdr result)))

(defun sql-show-columns (database-name table-name
				       &key  (user *db-debian-user*)
				             (put nil))
  "Showing `SHOW COLUMNS' statement for given table"
  (let* ((show-columns   (format nil "SHOW COLUMNS FROM `~a`.`~a`;"
				 database-name table-name))
	 (result         (query-database-and-return-list-of-lists
			  show-columns
			  :user     user
			  :database nil
			  :put      put)))
    (put-message result :put put)
    result))

(defun sql-show-column-name-list (database-name table-name
						&key  (user *db-debian-user*)
				                      (put nil))
  "Showing column names for given table"
  (let* ((result-0       (sql-show-columns database-name table-name :put nil))
	 (result-1       (loop
			  for list in result-0
			  collect (first list))))
    (put-message result-1 :put put)
    result-1))

(defun sql-show-create-table (database-name table-name
					    &key  (user *db-debian-user*)
					          (put nil))
  "Showing `CREATE TABLE' statement for given table"
  ;;
  ;; Design note:
  ;;
  ;; MySQL returns a list of strings, the first of which contains a TAB, like:
  ;;
  ;;  ("externallinks<tab>CREATE TABLE `externallinks` ("
  ;;   "  `el_from` int(10) unsigned NOT NULL DEFAULT '0',"
  ;;   "  `el_to` blob NOT NULL,"
  ;;   "  `el_index` blob NOT NULL,"
  ;;   "  KEY `el_from` (`el_from`,`el_to`(40)),"
  ;;   "  KEY `el_to` (`el_to`(60),`el_from`),"
  ;;   "  KEY `el_index` (`el_index`(60))"
  ;;   ") ENGINE=InnoDB DEFAULT CHARSET=binary ROW_FORMAT=COMPRESSED KEY_BLOCK_SIZE=4")
  ;;
  ;; We return everything after the TAB
  ;;
  (let ((show-create (format nil "SHOW CREATE TABLE `~a`.`~a`;"
			     database-name table-name))
	(result      nil)
	(result-0    nil)
	(result-1    nil))
    ;; we get a lot of failures from this query
    ;; if fail, retry up to three times
    (loop
     for i from 1 to 3
     do (sleep 1)
        (setq result      (query-database-and-return-list-of-strings
			   show-create
			   :user     user
			   :database nil
			   :put      put))
        (setq result-0    (pop result))
     thereis result-0)
    (setq result-1    (if (null result-0)
			  nil
			(second (regexp:regexp-split
				 (make-string 1 :initial-element #\Tab)
				 result-0))))
    (push result-1 result)
    (put-message result :put put)
    result))

(defun sql-show-databases (&key (user *db-wikiadmin-user*)
				(put  nil))
  "Showing all databases"
  (let* ((show-databases "SHOW DATABASES;")
	 (result         (query-database-and-return-list-of-strings
			  show-databases
			  :user     user
			  :database nil
			  :put      put)))
    (put-message result :put put)
    result))

(defun sql-show-databases-wpmirror (&key (user *db-wikiadmin-user*)
				    (put nil))
  "Showing all databases related to wp-mirror"
  (let* ((show-databases-1 "SHOW DATABASES LIKE '%wik%';")
	 (show-databases-2 "SHOW DATABASES LIKE 'wpmirror';")
	 (result           (append
			    (query-database-and-return-list-of-strings
			     show-databases-1
			     :user     user
			     :database nil
			     :put      put)
			    (query-database-and-return-list-of-strings
			     show-databases-2
			     :user     user
			     :database nil
			     :put      put))))
    (put-message result :put put)
    result))

(defun sql-show-grants (user &key (put nil))
  "Showing grants for given user"
  (let ((show-grants (format nil "SHOW GRANTS FOR `~a`@`~a`;"
			     user *db-server*)))
    (query-database-and-return-list-of-strings show-grants
					       :user     *db-debian-user*
					       :database nil
					       :put      put)))

(defun sql-show-tables (db-name &key (user *db-wikiuser-user*)
				(put  nil))
  "Showing tables in *db-wpmirror-name*"
  (let ((show-tables  (format nil "SHOW TABLES FROM `~a`;" db-name)))
    (query-database-and-return-list-of-strings show-tables
					       :user     user
					       :database nil
					       :put      put)))

(defun sql-show-table-status (db-name table-name &key (user *db-wikiuser-user*)
				      (put nil))
  "Showing table status"
  (let ((show-table-status
	 (format nil "SHOW TABLE STATUS FROM `~a` LIKE '~a';"
		 db-name table-name)))
    (query-database-and-return-list-of-lists show-table-status
					     :user user
					     :put  put)))

(defun sql-show-table-status-data-free (&key (db-name *db-wpmirror-name*)
					     (table-name "file")
					     (put nil))
  "Showing data_free as given by table status"
  (let ((result (sql-show-table-status db-name table-name :put put)))
    (if (null result)
	0
      (tenth (first result)))))

(defun sql-show-datadir (&key (put nil))
  "Showing data directory"
  (sql-show-variable "datadir" :put put))

(defun sql-show-innodb-buffer-pool-pages-dirty (&key (put nil))
  "Showing number of buffer pool pages that are modified"
  (sql-show-status "Innodb_buffer_pool_pages_dirty" :put put))

(defun sql-show-innodb-buffer-pool-pages-insert (&key (put nil))
  "Showing number of buffer pool pages used for insert buffer"
  ;;
  ;; Design note:
  ;;
  ;; Ideally, we would call
  ;;
  ;;   (sql-show-status "Innodb_buffer_pool_pages_insert" :put put))
  ;;
  ;; However, as of MySQL 5.5, InnoDB does not expose any status
  ;; variables regarding the insert buffer.  So for now we use a shell
  ;; script that queries:
  ;;
  ;;   SHOW ENGINE INNODB STATUS\G
  ;;
  ;; and then `grep's the output for the line containing `Ibuf: size'
  ;; which looks like:
  ;;
  ;;   Ibuf: size 1, free list len 0, seg size 2, 1 merges
  ;;
  ;; and then reads the third token; which, in this case, is `1'.
  ;;
  (let* ((pattern  "Ibuf: size")
	 (l        (shell-show-engine-innodb-status-grep pattern)))
    (if (or (null l) (zerop (length l)))
	0
      (with-input-from-string (s (third (regexp:regexp-split " " l)))
			      (read s)))))

(defun sql-show-innodb-buffer-pool-pages-misc (&key (put nil))
  "Showing number of buffer pool pages used for miscellaneous purposes"
  ;;
  ;; Design note:
  ;;
  ;; MySQL 5.5 miscomputes this.  Do not use.
  ;;
  (sql-show-status "Innodb_buffer_pool_pages_misc" :put put))

(defun sql-show-innodb-buffer-pool-pages-total (&key (put nil))
  "Showing number of buffer pool pages"
  (sql-show-status "Innodb_buffer_pool_pages_total" :put put))

(defun sql-show-innodb-data-file-path (&key (put nil))
  "Showing filepath to InnoDB table space"
  (put-message (_ "Showing InnoDB data file path") :put put)
  (let* ((datadir   (sql-show-datadir :put put))
	 (result    (sql-show-variable "innodb_data_file_path" :put put))
	 (file-path nil)
	 (size      nil)
	 (rawp      nil))
    (if (null result)
	(put-message-value-fail-and-abort
	 (_ "show innodb_data_file_path returned") result)
      (setq file-path result))
    (put-message-value (_ "innodb_data_file_path") file-path :put put)
    ;; this file path may contain a colon ':' such as 
    ;;   'ibdata1:10M:autoextend'              # this is the default
    ;;   '/dev/mapper/vg0-ibdata0:300000Mraw'  # this is a raw partition
    ;; HDD manufacturers define 'K' as 1000, 'M' as 1000^2, and 'G' as 1000^3
    ;; MySQL however defines    'K' as 1024, 'M' as 1024^2, and 'G' as 1024^3
    (setq size
	  (string-right-trim
	   "RAWraw" (second (regexp:regexp-split ":" file-path))))
    (setq size
	  (cond ((regexp:match "K" size)
		 (* (read-from-string (string-right-trim "K" size)) 1024))
		((regexp:match "M" size)
		 (* (read-from-string (string-right-trim "M" size)) 1024 1024))
		((regexp:match "G" size)
		 (* (read-from-string (string-right-trim "G" size))
		    1024 1024 1024))
		(t (read-from-string size))))
    (setq rawp
	  (or (regexp:match
	       "raw" (second (regexp:regexp-split ":" file-path)))
	      (regexp:match
	       "RAW" (second (regexp:regexp-split ":" file-path)))))
    (setq file-path (first  (regexp:regexp-split ":" file-path)))
    (put-message-value (_ "innodb_data_file_path trimmed") file-path :put put)
    (put-message-value (_ "innodb_data_file_path size")    size      :put put)
    (put-message-value (_ "innodb_data_file_path rawp")    rawp      :put put)
    ;; the default case only gives the file-name, so merge directory path
    (let ((path-dir (pathname-directory (parse-namestring file-path))))
      (when (null path-dir)
	(put-message-value (_ "datadir") datadir :put put)
	(setq file-path (merge-pathnames file-path datadir))
	(put-message-value (_ "table space path") file-path :put put)))
    (values file-path size rawp)))

(defun sql-show-innodb-file-format (&key (put nil))
  "Showing InnoDB file format (`Antelope' or `Barracuda')"
  (sql-show-variable "innodb_file_format" :put put))

(defun sql-show-innodb-data-home-dir (&key (put nil))
  "Showing InnoDB data home directory"
  (sql-show-variable "innodb_data_home_dir" :put put))

(defun sql-show-status (str &key (put nil))
  "Showing MySQL status `str'"
  (let ((result (query-database-and-return-list-of-lists
		 (format nil "SHOW STATUS LIKE '~a';" str)
		 :user     *db-wikiadmin-user*
		 :database nil
		 :put put)))
    (if (null result)
	0
      (second (first result)))))

(defun sql-show-variable (str &key (put nil))
  "Showing MySQL variable `str'"
  (let ((result (query-database-and-return-list-of-lists
		 (format nil "SHOW VARIABLES LIKE '~a';" str)
		 :user     *db-wikiadmin-user*
		 :database nil
		 :put put)))
    (if (null result)
	0
      (second (first result)))))

(defun sql-truncate-table-time (&key (put nil))
  "Truncate the `wpmirror.time' database table"
  (let ((truncate-table (concatenate 'string
	  (format nil "TRUNCATE TABLE `~a`.`time`; " *db-wpmirror-name*)
	  "INSERT INTO `time` (`run`,`function_name`,`file_name`,`real_time`,"
	  "`disk_usage_mysql_datadir`,`disk_usage_working_dir`,"
	  "`partition_free_images`,`partition_free_innodb`) "
	  "VALUES "
	  (format nil "(0,'sql-truncate-table-time','nil',0,~d,~d,~d,~d);"
		  (shell-du-mysql-datadir       :put put)
		  (shell-du-wpmirror-working    :put put)
		  (system-partition-free-images :put put)
		  (system-partition-free-innodb :put put)))))
    (query-database-and-return-stream truncate-table
				      :user     *db-wikiadmin-user*
				      :database *db-wpmirror-name*
				      :put      put)))

(defun sql-update-fail-to-valid (&key (put nil))
  "Updating all failed `table's and `xchunk's"
  (put-message-start (_ "updating state from `fail' to `valid'") :put put)
  (put-message (_ "to give failed chunks a second chance") :put put)
  (let ((update (format nil "UPDATE `~a`.`file` SET `state`='valid' WHERE `state`='fail' AND `type` IN ('table','xchunk');"
			*db-wpmirror-name*)))
    (put-message update :put put)
    (query-database-and-return-stream update :put put)
    (put-message-done (_ "updating state from `fail' to `valid'") :put put)
    t))

(defun sql-update-fail-to-start (&key (put nil))
  "Updating all failed `database's and `xchunk's"
  (put-message-start (_ "updating state from `fail' to `start'") :put put)
  (put-message (_ "to give failed chunks a second chance") :put put)
  (let ((update (format nil "UPDATE `~a`.`file` SET `state`='start' WHERE `state`='fail' AND `type` IN ('database','xchunk','xincr');"
			*db-wpmirror-name*)))
    (put-message update :put put)
    (query-database-and-return-stream update :put put)
    (put-message-done (_ "updating state from `fail' to `start'") :put put)
    t))

(defun sql-update-file (file-name &key (size nil) (md5sum nil) (state nil)
				  (page nil) (pages nil) (images nil)
				  (semaphore nil)
				  (put nil))
  "Updating file size, md5sum, state, page, pages, images, updates"
  (let* ((state-old   (sql-select-file-state   file-name :put put))
	 (updates-old (sql-select-file-updates file-name :put put))
	 (updates-new (1+ updates-old))
	 (update (concatenate 'string
	           (format nil "UPDATE `~a`.`file` SET " *db-wpmirror-name*)
		   (unless (null size)     (format nil "`size`=~d,"       size))
		   (unless (null md5sum)   (format nil "`md5sum`='~a'," md5sum))
		   (unless (null state)    (format nil "`state`='~a',"   state))
		   (unless (null page)     (format nil "`page`=~d,"       page))
		   (unless (null pages)    (format nil "`pages`=~d,"     pages))
		   (unless (null images)   (format nil "`images`=~d,"   images))
		   (unless (null semaphore)
		     (format nil "`semaphore`=~d," semaphore))
		   (format nil "`updates`=~d " updates-new)
		   (format nil "WHERE `name`='~a';" file-name))))
    (put-message-value (_ "state-old")          state-old   :put put)
    (put-message-value (_ "updates-old")        updates-old :put put)
    (put-message-value (_ "sql-update-command") update      :put put)
    (query-database-and-return-stream update :put put)
    (put-message-value (_ "new file record")
		       (sql-select-file file-name :put nil)
		       :put put)
    t))

(defun sql-update-file-images (file-name images &key (put nil))
  "Updating images per file"
  (sql-update-file file-name :images images :put put))

(defun sql-update-file-md5sum (file-name md5sum &key (put nil))
  "Updating file md5sum"
  (sql-update-file file-name :md5sum md5sum :put put))

(defun sql-update-file-page (file-name page &key (put nil))
  "Updating file start page"
  (sql-update-file file-name :page page :put put))

(defun sql-update-file-pages (file-name pages &key (put nil))
  "Updating pages per file"
  (sql-update-file file-name :pages pages :put put))

(defun sql-update-file-semaphore (file-name semaphore &key (put nil))
  "Updating semaphore"
  ;; Only use this function for releasing the lock (setting semaphore
  ;; to 1).  Grabbing the lock must be isolated from other
  ;; transactions (see sql-select-next-file for details)
  (let* ((update (concatenate 'string
		    "START TRANSACTION;"
		    (format nil "UPDATE `~a`.`file` SET `semaphore`=~d "
			    *db-wpmirror-name* semaphore)
		    (format nil "WHERE `name`='~a';" file-name)
		    (format nil "SELECT `semaphore` FROM `~a`.`file` "
			    *db-wpmirror-name*)
		    (format nil "WHERE `name`='~a';" file-name)
		    "COMMIT;"))
	 (result (sql-select-numeric update :put put)))
    (if (zerop result)
	(put-message-value (_ "grab lock - update semaphore")
			   (format nil "~d-->~d" semaphore result)
			   :put put)
      (put-message-value (_ "release lock - update semaphore")
			 (format nil "~d-->~d" semaphore result)
			 :put put))))

(defun sql-update-file-semaphore-all (semaphore &key (put nil))
  "Updating all semaphores"
  (let ((update (format nil "UPDATE `~a`.`file` SET `semaphore`=~d;"
			*db-wpmirror-name* semaphore)))
    (put-message-value (_ "update") update :put put)
    (query-database-and-return-stream update :put put)
    t))

(defun sql-update-file-size (file-name &key (put nil))
  "Updating file size"
  (let ((record-size (sql-select-file-size file-name :put put))
	(actual-size nil))
    (put-message-value (_ "record size") record-size :put put)
    (if (ext:probe-pathname file-name)
	(progn
	  (setq actual-size (posix:file-size file-name))
	  (put-message-value (_ "actual size") actual-size :put put)
	  (unless (eql record-size actual-size)
	    (sql-update-file file-name :size actual-size :put put)))
      (put-message-value-fail-and-abort (_ "file not found") file-name)))
  t)

(defun sql-update-file-state (file-name state &key (put nil))
  "Updating file state"
  (sql-update-file file-name :state state :put put))


;;;;--------------------------------------------------------------------------+
;;;; Www utilities:                                                           |
;;;;  - assert-internet-access-p                                              |
;;;;  - download-directory-list                                               |
;;;;  - download-file                                                         |
;;;;  - download-file-size-local                                              |
;;;;  - download-file-size-remote                                             |
;;;;  - select-sites-for-dump-files                                           |
;;;;  - url-to-protocol                                                       |
;;;;--------------------------------------------------------------------------+


(defun assert-internet-access-p (url &key (put nil))
  "Asserting internet access to given URL"
  ;; Bug: this will not detect a failure if:
  ;; a) your traffic is going through a caching web proxy that, 
  ;; b) has already cached a copy of the page, and 
  ;; c) then suffers a failure lying between the proxy and the URL host
  (let ((protocol (url-to-protocol url :put put)))
    (case protocol
	  (:http  (shell-wget-connection  url :put put))
	  (:ftp   (shell-wget-connection  url :put put))
	  (:rsync (shell-rsync-connection url :put put))
	  (otherwise
	   (put-message-value-fail-and-abort (_ "unknown protocol") url)))))

(defun download-directory-list (url &key (put nil))
  "Downloading directory list from given URL."
  (let ((protocol (url-to-protocol url :put put)))
    (case protocol
	  (:http  (or
		   (shell-wget-http-directory-list     url :put put)
		   (shell-wget-http-directory-list-alt url :put put)))
	  (:ftp   (shell-wget-ftp-directory-list url :put put))
	  (:rsync (shell-rsync-directory-list    url :put put))
	  (otherwise
	   (put-message-value-fail-and-abort (_ "unknown protocol") url)))))

(defun download-file (url file-name &key (put nil))
  "Downloading file from given URL."
  (let ((protocol (url-to-protocol url :put put)))
    (case protocol
	  (:http  (shell-wget-file  url file-name :put put))
	  (:ftp   (shell-wget-file  url file-name :put put))
	  (:rsync (shell-rsync-file url file-name :put put))
	  (otherwise
	   (put-message-value-fail-and-abort (_ "unknown protocol") url)))))

(defun download-file-size-local-ftp (file-name &key (put nil))
  "Looking up size of local file"
  (download-file-size-local-http file-name :put put))

(defun download-file-size-local-http (file-name &key (put nil))
  "Looking up size of local file"
  (if (null file-name)
      0
    (let* ((file-path   (merge-pathnames
			 (parse-namestring *whereis-directory-wpmirror-working*)
			 (parse-namestring file-name)))
	   (file-size-1 (fourth
			 (multiple-value-list
			  (ext:probe-pathname file-path))))
	   (file-size   (or file-size-1
			    (sql-select-file-size file-name :put put))))
      ;(put-message-value file-name file-size :put t)
      file-size)))

(defun download-file-size-local-rsync (file-name &key (put nil))
  "Looking up size of local file"
  (let* ((partial-stem (format nil ".~a" file-name))
	 (partial-name (first (shell-ls-grep-all
			       *whereis-directory-wpmirror-working*
			       partial-stem :put put))))
    (if partial-name
	(download-file-size-local-http partial-name :put put)
      (download-file-size-local-http file-name :put put))))

(defun download-file-size-local (file-name &key (put nil))
  "Determining size of file (before, during, after) downloaded"
  (let ((protocol (url-to-protocol *wikimedia-site-xdump* :put put)))
    (case protocol
	  (:http  (download-file-size-local-http  file-name :put put))
	  (:ftp   (download-file-size-local-ftp   file-name :put put))
	  (:rsync (download-file-size-local-rsync file-name :put put))
	  (otherwise
	   (put-message-value-fail-and-abort (_ "unknown protocol") url)))))

(defun download-file-size-remote-ftp (url &key (put nil))
  "Determining size of file to be downloaded"
  ;;
  ;; Design note:
  ;;
  ;; Looking for line in directory list that looks like:
  ;;
  ;; `-rw-r----- 1 ftp  ftp  6946 Feb 20 00:53 zuwiki-yyyymmdd-pages-art...'
  ;;
  ;; The fifth item `6946' is the file size.
  ;;
  (let* ((file-name     (first (last (regexp:regexp-split "/" url))))
	 (lines         (shell-wget-http-file-head url :put put))
	 (dir-line      nil)
	 (string-list   nil)
	 (size-str      nil)
	 (size          0))
    (when lines
      (setq dir-line    (loop
			 for line in lines
			 when (and (regexp:match file-name line)
				   (regexp:match "rw-" line))
			 return line)))
    (when dir-line
      (setq string-list (loop
			 for elem in (regexp:regexp-split " " dir-line)
			 when (> (length elem) 0)
			 collect elem)))
    (when string-list
      (setq size-str    (fifth string-list)))
    (when size-str
      (setq size        (with-input-from-string (s size-str)
						(read s))))
    size))

(defun download-file-size-remote-http (url &key (put nil))
  "Determining size of file to be downloaded"
  ;;
  ;; Design note:
  ;;
  ;; Looking for HTTP header line that looks like:
  ;;
  ;; `Content-Length: 6946'
  ;;
  ;; The second item `6946' is the file size.
  ;;
  (let* ((lines         (shell-wget-http-file-head url :put put))
	 (size-str      nil)
	 (size          0))
    (when lines
      (setq size-str    (loop
			 for line in lines
			 when (regexp:match "Content-Length" line)
			 return (second (regexp:regexp-split ":" line)))))
    (when size-str
      (setq size        (with-input-from-string (s size-str)
						(read s))))
    size))

(defun download-file-size-remote-rsync (url &key (put nil))
  "Determining size of file to be downloaded"
  ;;
  ;; Design note:
  ;;
  ;; Looking for line that looks like:
  ;;
  ;; `-rw-rw-r--  6946 2014/02/19 19:53:53 zuwiki-yyyymmdd-pages-art...'
  ;;
  ;; The second item `6946' is the file size.
  ;;
  (let* ((line          (shell-rsync-file-head url :put put))
	 (string-list   nil)
	 (size-str      nil)
	 (size          0))
    (when line
      (setq string-list (cdr (regexp:regexp-split " " line))))
    (when string-list
      (setq size-str    (loop
			 for str in string-list
			 when (> (length str) 0)
			 return str)))
    (when size-str
      (setq size        (with-input-from-string (s size-str)
						(read s))))
    size))

(defun download-file-size-remote (url &key (put nil))
  "Determining size of file to be downloaded"
  (let ((protocol (url-to-protocol url :put put)))
    (case protocol
	  (:http  (download-file-size-remote-http  url :put put))
	  (:ftp   (download-file-size-remote-ftp   url :put put))
	  (:rsync (download-file-size-remote-rsync url :put put))
	  (otherwise
	   (put-message-value-fail-and-abort (_ "unknown protocol") url)))))

(defun select-site-idump (&key (put nil))
  "Selecting site for `idump' files from a fallback list"
  (loop
   with site-fallback-list = *wikimedia-site-idump-fallback-list*
   for site in site-fallback-list
   as site-name   = (third (regexp:regexp-split "/" site))
   as result-ipv4 = (shell-ping-site  site-name :put put)
   as result-ipv6 = (shell-ping6-site site-name :put put)
   as succeed-p   = (or result-ipv4 result-ipv6)
   as val-string  = (format nil "ping ~a  ping6 ~a" result-ipv4 result-ipv6)
   if succeed-p do (put-message-value-pass site val-string :put put)
                   (setq *wikimedia-site-idump* site)
                   (put-flag-message-value :info (_ "*wikimedia-site-idump*")
					   *wikimedia-site-idump*)
		   (return t)
   else         do (put-message-value-fail site val-string :put put)))

(defun select-site-image (&key (put nil))
  "Selecting site for `image' files from a fallback list"
  (loop
   with site-fallback-list = *wikimedia-site-image-fallback-list*
   for site in site-fallback-list
   as site-name   = (third (regexp:regexp-split "/" site))
   as result-ipv4 = (shell-ping-site  site-name :put put)
   as result-ipv6 = (shell-ping6-site site-name :put put)
   as succeed-p   = (or result-ipv4 result-ipv6)
   as val-string  = (format nil "ping ~a  ping6 ~a" result-ipv4 result-ipv6)
   if succeed-p do (put-message-value-pass site val-string :put put)
                   (setq *wikimedia-site-image* site)
                   (put-flag-message-value :info (_ "*wikimedia-site-image*")
					   *wikimedia-site-image*)
		   (return t)
   else         do (put-message-value-fail site val-string :put put)))

(defun select-site-xdump (&key (put nil))
  "Selecting site for `xdump' files from a fallback list"
  (loop
   with site-fallback-list = *wikimedia-site-xdump-fallback-list*
   for site in site-fallback-list
   as site-name   = (third (regexp:regexp-split "/" site))
   as result-ipv4 = (shell-ping-site  site-name :put put)
   as result-ipv6 = (shell-ping6-site site-name :put put)
   as succeed-p   = (or result-ipv4 result-ipv6)
   as val-string  = (format nil "ping ~a  ping6 ~a" result-ipv4 result-ipv6)
   if succeed-p do (put-message-value-pass site val-string :put put)
                   (setq *wikimedia-site-xdump* site)
		   (put-flag-message-value :info (_ "*wikimedia-site-xdump*")
					   *wikimedia-site-xdump*)
		   (return t)
   else         do (put-message-value-fail site val-string :put put)))

(defun select-site-xincr (&key (put nil))
  "Selecting site for `xincr' files from a fallback list"
  (loop
   with site-fallback-list = *wikimedia-site-xincr-fallback-list*
   for site in site-fallback-list
   as site-name   = (third (regexp:regexp-split "/" site))
   as result-ipv4 = (shell-ping-site  site-name :put put)
   as result-ipv6 = (shell-ping6-site site-name :put put)
   as succeed-p   = (or result-ipv4 result-ipv6)
   as val-string  = (format nil "ping ~a  ping6 ~a" result-ipv4 result-ipv6)
   if succeed-p do (put-message-value-pass site val-string :put put)
                   (setq *wikimedia-site-xincr* site)
		   (put-flag-message-value :info (_ "*wikimedia-site-xincr*")
					   *wikimedia-site-xincr*)
		   (return t)
   else         do (put-message-value-fail site val-string :put put)))

(defun select-sites-for-dump-files (&key (put nil))
  "Selecting sites for dump files"
  (select-site-idump :put put)
  (select-site-image :put put)
  (select-site-xdump :put put)
  (select-site-xincr :put put)
  (put-flag-message :done (_ "done"))
  t)

(defun url-to-protocol (url &key (put nil))
  "Determining URL protocol (ftp, http, rsync)"
  (let ((protocol (first (regexp:regexp-split ":" url))))
    (cond ((string= protocol "http")  :http )
	  ((string= protocol "ftp")   :ftp  )
	  ((string= protocol "rsync") :rsync)
	  (t (put-message-value-fail-and-abort (_ "unknown protocol") url)))))


;;;;--------------------------------------------------------------------------+
;;;; Error messages detailed:                                                 |
;;;;--------------------------------------------------------------------------+


(defparameter *error-messages* (make-hash-table :test 'equal))


;;;;--------------------------------------------------------------------------+
;;;; Assert prerequisite hardware:                                            |
;;;;--------------------------------------------------------------------------+


(defun assert-disk-space-if-large-wikipedia-p (&key (put nil))
  "Asserting adequate free space on partition"
  (let* ((partition-images-free (system-partition-free-images :put put))
	 (space-have          (format-integer-for-human partition-images-free))
         (space-warn          (format-integer-for-human
			       *system-partition-free-images-start-min*))
	 (space-p             (>= partition-images-free
				  *system-partition-free-images-start-min*))
	 (language-code-list  (mirror-language-code-list :put put))
	 (large-language-p    (or (mirror-commonswiki-p :put put)
				  (and (intersection
					language-code-list
					*wikimedia-large-language-code-list*
					:test #'string=)
				       t))))
    (put-message-value (_ "partition images free") space-have :put put)
    ;; assert if we have one of the largest wiki's
    (put-message-value (_ "our languages are") language-code-list :put put)
    (put-message-value (_ "large languages are")
		       *wikimedia-large-language-code-list*
		       :put put)
    (put-message-value (_ "are any of our languages large") large-language-p
		       :put put)
    (when (and large-language-p (not space-p))
      (put-flag-message :info
	      (format nil "disk space below threshold for large languages (~a < ~a)" 
		      space-have space-warn))
      (put-flag-message :done (_ "done")))
    (or (not large-language-p) space-p)))

(defun warn-if-disk-space-low-p (&key (put nil))
  "Warning if low free space on partition"
  (let* ((partition-images-free (system-partition-free-images :put put))
	 (space-have   (format-integer-for-human partition-images-free))
         (space-warn   (format-integer-for-human
			*system-partition-free-images-warn*))
	 (space-p      (>= partition-images-free
			*system-partition-free-images-warn*)))
    (put-message-value (_ "detecting")        space-have :put put)
    (put-message-value (_ "warning if below") space-warn :put put)
    (when (null space-p)
      (put-flag-message :info
			(format nil "disk space below threshold (~a < ~a)" 
				space-have space-warn))
      (put-flag-message :done (_ "done")))
    space-p))

(defun system-hugepage-size-list (&key (put nil))
  "Determining the size [kB] of hugepages, return list of integers"
  ;;
  ;; Design note:
  ;;
  ;; Modern CPUs and OSs support hugepages in one or more sizes.
  ;;
  ;; Sysfs.  1) The root hugepage control directory is
  ;;
  ;;     "/sys/kernel/mm/hugepages/"
  ;;
  ;; 2) For each hugepage size supported by the kernel, a subdirectory
  ;; will exist with a name like
  ;;
  ;;     "hugepages-xxxxkB" 
  ;;
  ;; where xxxx is the hugepage size in kilobytes.
  ;;
  ;; 3) Within each of these directories the same set of files will
  ;; exist:
  ;;
  ;;     free_hugepages
  ;;     nr_hugepages
  ;;     nr_hugepages_mempolicy
  ;;     nr_overcommit_hugepages
  ;;     resv_hugepages
  ;;     surplus_hugepages
  ;;
  (let* ((sys-dir-list-wild    '(:absolute "sys" "kernel" "mm" "hugepages"
					   :wild))
	 (sub-dir-pathname-list (directory (make-pathname
					    :directory sys-dir-list-wild))))
    (loop 
       ;; sub-dir-pathname - #P"/sys/kernel/mm/hugepages/hugepages-2048kB/"
       for sub-dir-pathname in sub-dir-pathname-list
       ;; sub-dir          - "hugepages-2048kB"
       as sub-dir     = (first (last (pathname-directory sub-dir-pathname)))
       ;; size-string      - "2048"
       as size-string = (string-trim "kB" 
				     (second (regexp:regexp-split "-" sub-dir)))
       ;; size-int         - 2048
       as size-int    = (with-input-from-string (s size-string) (read s))
       collect size-int)))

(defun system-hugepage-alist (hugepage-size &key (put nil))
  "Determining numbers (total, free, etc.) of hugepages of given size, returns alist"
  ;;
  ;; Design note:
  ;;
  ;; Sysfs. Given hugepage-size=2048, each of the following files is read:
  ;;
  ;; (#P"/sys/kernel/mm/hugepages/hugepages-2048kB/nr_hugepages_mempolicy"
  ;;  #P"/sys/kernel/mm/hugepages/hugepages-2048kB/surplus_hugepages"
  ;;  #P"/sys/kernel/mm/hugepages/hugepages-2048kB/resv_hugepages"
  ;;  #P"/sys/kernel/mm/hugepages/hugepages-2048kB/free_hugepages"
  ;;  #P"/sys/kernel/mm/hugepages/hugepages-2048kB/nr_overcommit_hugepages"
  ;;  #P"/sys/kernel/mm/hugepages/hugepages-2048kB/nr_hugepages")
  ;;
  ;; An alist of key-value pairs is returned:
  ;;
  ;; (("nr_hugepages_mempolicy" . 512) ("surplus_hugepages" . 0)
  ;;  ("resv_hugepages" . 6) ("free_hugepages" . 511)
  ;;  ("nr_overcommit_hugepages" . 0) ("nr_hugepages" . 512))
  ;;
  (let* ((sys-dir-list  (append
			 '(:absolute "sys" "kernel" "mm" "hugepages")
			 (list (format nil "hugepages-~akB" hugepage-size))))
	 ;; pathname-wild - "/sys/kernel/mm/hugepages/hugepages-2048kB/*"
	 (pathname-wild (make-pathname :directory sys-dir-list :name :wild))
	 ;; pathname-list -
	 ;;
	 (pathname-list (directory pathname-wild)))
    (loop
     for path in pathname-list
     as  key  = (pathname-name path)
     as  val  = (with-open-file (s path :direction :input) 
				(read s))
     collect (cons key val))))

(defun system-partition-free-images (&key (put nil))
  "Determining free space [bytes] on HDD partition that stores images"
  (system-partition-free *whereis-directory-mediawiki-images* :put put))

(defun system-partition-free-innodb (&key (put nil)) 
  "Determining free space [bytes] on HDD partition that stores InnoDB table space"
  (multiple-value-bind (path size rawp) 
      (sql-show-innodb-data-file-path :put put)
    (if rawp
	(sql-show-table-status-data-free :put put)
      (system-partition-free path :put put))))

(defun system-partition-free (path &key (put nil))
  "Determining free space [bytes] on HDD partition that holds `path'"
  (let* ((fs             (posix:stat-vfs path))           ; this is a struct
	 (bfree          (stat-vfs-bfree  fs))            ; accessor
	 (frsize         (stat-vfs-frsize fs))            ; accessor
	 (partition-free (* bfree frsize)))
    (debug-message-value (_ "free blocks") (stat-vfs-bfree  fs))
    (debug-message-value (_ "block size")  (stat-vfs-frsize fs))
    partition-free))

(defun system-partition-size-images (&key (put nil))
  "Determining size [bytes] of HDD partition that stores images"
  (system-partition-size *whereis-directory-mediawiki-images* :put put))

(defun system-partition-size-innodb (&key (put nil))
  "Determining size [bytes] of HDD partition that stores InnoDB table space"
  (multiple-value-bind (path size rawp) 
      (sql-show-innodb-data-file-path :put put)
    (if rawp
	size
      (system-partition-size path :put put))))

(defun system-partition-size (path &key (put nil))
  "Determining size [bytes] of HDD partition that stores `path'"
  (let* ((fs             (posix:stat-vfs path))           ; this is a struct
	 (blocks         (stat-vfs-blocks fs))            ; accessor
	 (frsize         (stat-vfs-frsize fs))            ; accessor
	 (partition-size (* blocks frsize)))
    (debug-message-value (_ "blocks")      (stat-vfs-blocks fs))
    (debug-message-value (_ "block size")  (stat-vfs-frsize fs))
    partition-size))

(defun warn-if-database-stored-on-virtual-disk-p (&key (put nil))
  "Warning if database stored on virtual disk"
  ;;
  ;; Design note:
  ;;
  ;; Disks that do not provide identification are probably virtual
  ;; disks in a Virtual Machine.  
  ;;
  (let* ((device-name-list       (hdd-pathname-physical :put put))
	 (disk-identification-p-list
	  (mapcar #'(lambda (device-name)
		      (shell-hdparm-identification-p device-name :put put))
		  device-name-list))
	 (disk-identification-p     nil))
    (put-message-value (_ "disk-identification-p-list")
		       disk-identification-p-list :put put)
    (setq disk-identification-p
	  (notany #'null disk-identification-p-list))
    (put-message-value (_ "do all disks provide identification")
		       disk-identification-p :put put)
    (defparameter *system-hdd-identification-p* disk-identification-p)
    (when (null disk-identification-p)
      (loop
       for device-name in device-name-list
       as  disk-ident-p in disk-identification-p-list
       do (put-flag-message :info
			    (format nil "~a: ~a" device-name
				    (if disk-ident-p 
					(_ "disk identification found")
				      (_ "disk identification NOT found"))))
       (put-flag-message :done (_ "done"))))
    ;;(die) ; uncomment when debug
    disk-identification-p))

(defun assert-hdd-write-cache-p (&key (put nil))
  "Asserting IDE/SATA drive write cache is disabled/enabled"
  ;;
  ;; Design note:
  ;;
  ;; Hard disks have a write cache in order to schedule the movements
  ;; of the read-write heads more efficiently, using something like
  ;; the `elevator algorythm'.
  ;;
  ;; Disabling disk write cache is however important for an ACID
  ;; compliant DBMS.  The issue here is Durability (the `D' in
  ;; `ACID').  Transactions that `commit' must actually be written to
  ;; disk, and not remain in cache, where they may be lost during
  ;; system failure.
  ;;
  ;; This is configurable by setting *system-hdd-write-cache*.
  ;;
  (let* ((device-name-list              *system-hdd-name-list*)
	 (write-cache-configured-p-list '())
	 (write-cache-configured-p      nil))
    (when *system-hdd-identification-p*
      (setq write-cache-configured-p-list
	    (mapcar #'(lambda (device-name)
			(shell-hdparm-write-cache-p device-name :put put))
		    device-name-list))
      (put-message-value (_ "write-cache-configured-p-list")
			 write-cache-configured-p-list :put put)
      (setq write-cache-configured-p
	    (notany #'null write-cache-configured-p-list)))
    (put-message-value (_ "are all write caches configured")
		       write-cache-configured-p :put put)
    ;;(die) ; uncomment when debug
    write-cache-configured-p))

(defun hdd-pathname-physical (&key (put nil))
  "Determining pathnames of physical disks underlying database"
  ;;
  ;; Design note:
  ;;
  ;; 1) In step 1 below, MySQL is queried as to its InnoDB data file
  ;; path.  This means that the hard drive is identified after MySQL
  ;; credentials have been asserted.  Simply put, the H/W feature is
  ;; asserted after the S/W feature.  
  ;;
  ;; 2) In step 6 below, `sysfs' is used to identify the hard drive(s)
  ;; underlying the InnoDB data file.  `sysfs' exists to make system
  ;; resource discovery easier.  A prudent disk storage solution
  ;; features [LVM2 over LUKS over RAID over whole disks].  Without
  ;; `sysfs' this function could have been a chore to write.
  ;;
  ;; The list of HDDs is then kept in *system-hdd-name-list*.
  ;;
  (let ((table-space-path           nil)
	(partition-or-file          nil)
	(absolute-path              nil)
	(device-id                  nil)
	(device-id-major            nil)
	(device-id-minor            nil)
	(device-id-major-minor      nil)
	(block-device-init          nil)
	(sys-pathname-init          nil)
	(device-name                nil)
	(dev-path                   (make-pathname :directory "dev"))
	(dir-list-init              nil)
	(physical-block-device-list nil))
    ;; 1) Get path to table space, usually `/var/lib/mysql/ibdata1'
    (setq table-space-path (sql-show-innodb-data-file-path :put put))
    (put-message-value (_ "table space path") table-space-path :put put)

    ;; 2) path may be a symbolic link---chase it
    (setq absolute-path (ext:probe-pathname table-space-path))
    (put-message-value (_ "absolute path") absolute-path :put put)

    ;; 3) Innodb data file path will be either a file or a partition
    (if (zerop (posix:file-size absolute-path))
	(setq partition-or-file :partition)
      (setq  partition-or-file :file))
    (put-message-value (_ "path is partition or file") partition-or-file
		       :put put)
    
    (case partition-or-file
      (:file 
       ;; 4a) find device ID of device containing file (but it may be mapped)
       (setq device-id (file-stat-dev (posix:file-stat absolute-path)))
       (debug-message-value (_ "device-id") device-id)
       (multiple-value-setq (device-id-major device-id-minor)
	 (floor device-id 256))
       (setq device-id-major-minor (format nil "~d:~d"
					   device-id-major device-id-minor))
       (put-message-value (_ "device-id-major-minor") device-id-major-minor
			  :put put)
       ;; 4b) set initial block-device and dir-list
       (setq block-device-init device-id-major-minor)
       (setq dir-list-init (append '(:absolute "sys" "dev" "block")
				   (list block-device-init))))
      (:partition
       ;; 5a) assert `/dev/foo', block device is `foo' (but it may be mapped)
       (debug-message-value (_ "dev directory")  (pathname-directory dev-path))
       (debug-message-value (_ "pathname-directory data")
			    (pathname-directory absolute-path))
       (debug-message-value (_ "pathname-name data")
			    (pathname-name absolute-path))
       (unless (equal (pathname-directory absolute-path)
		      (pathname-directory dev-path))
	 (put-message-value-fail-and-abort (_ "should be block device")
					   absolute-path))
       ;; 5b) set initial block-device and dir-list
       (setq block-device-init (pathname-name absolute-path))
       (put-message-value (_ "block-device-init") block-device-init :put put)
       (setq dir-list-init (append '(:absolute "sys" "block")
				   (list block-device-init)))))
    (debug-message-value (_ "dir-list-init") dir-list-init)
    (setq sys-pathname-init (make-pathname :directory dir-list-init))
    (put-message-value (_ "sys-pathname-init") sys-pathname-init :put put)

    ;; 6) now go to `/sys', find block device, and chase slaves
    (setq physical-block-device-list
	  (sys-pathname-slaves sys-pathname-init :put put))
    (put-message-value (_ "physical-block-device-list")
		       physical-block-device-list :put put)

    ;; 7) now find the device names of the disk(s) underlying the
    ;; block device(s),
    ;;
    ;; Design note:
    ;;
    ;; Physical block devices look like:
    ;;
    ;; /sys/devices/pci0000:00/0000:00:1f.2/host0/target0:0:0/0:0:0:0/block/sda/sda6/
    ;;
    ;; So we take the item just after `block' in the directory
    ;; pathname (`sda' in this case) and format it like `/dev/sda'
    ;;
    (let* ((device-name-list
	    (mapcar #'(lambda (hdd)
			(format nil "/dev/~a"
				(second (member "block" 
						(pathname-directory hdd)
						:test #'string=))))
		    physical-block-device-list))
	   (dummy0  (debug-message-value (_ "device-name-list") device-name-list
				       :put put)))
      (defparameter *system-hdd-name-list* device-name-list)
      (put-message-value (_ "device-name-list") device-name-list :put put)
      device-name-list)))

(defun sys-pathname-slaves (sys-pathname &key (put nil))
  "Determining `/sys' pathnames of slaves below given `/sys' pathname"
  ;;
  ;; Design note:
  ;;
  ;; A given block device may be mapped to several slaves (e.g. RAID).
  ;; This means `/sys/block/<dev>/slaves/<dev>/slaves/...'  has the
  ;; topology of a tree.  The leaves of the tree (i.e. devices with no
  ;; slaves) are the physical block devices.
  ;;
  ;; This function assumes that the given `sys-block-pathname' starts
  ;; somewhere within the `/sys' filesystem, perhaps `/sys/block' or
  ;; `/sys/dev/block'.  The function chases slaves from there by tree
  ;; search.  This tree search is done using recursion.  The function
  ;; returns a list of sys-block-pathnames to physical block devices.
  ;;
  (put-message (_ "-----sys-pathname-slaves-----")   :put put)
  (put-message-value (_ "sys-pathname") sys-pathname :put put)
  (let* ((dir-list              (pathname-directory sys-pathname))
	 (block-device          (first (last dir-list)))
	 (dir-list-slaves       (append dir-list (list "slaves")))
	 (sys-pathname-slaves   (make-pathname :directory dir-list-slaves))
	 (sys-pathname-slaves-p (directory sys-pathname-slaves))
	 (dir-list-slaves-wild  (append dir-list (list "slaves" :wild)))
	 (sys-pathname-slaves-wild
	                        (make-pathname :directory dir-list-slaves-wild))
	 (sys-pathname-slaves-found 
	                        (directory sys-pathname-slaves-wild)))
    (unless (and (eql     (first  dir-list) :absolute)
		 (string= (second dir-list) "sys"))
      (put-message-fail-and-abort (_ "invalid sys-pathname")))
    (debug-message-value   (_ "block-device")         block-device)
    (debug-message-value (_ "dir-list")               dir-list)
    (debug-message-value (_ "dir-list-slaves")        dir-list-slaves)
    (debug-message-value (_ "sys-pathname-slaves")    sys-pathname-slaves)
    (debug-message-value (_ "sys-pathname-slaves-p")  sys-pathname-slaves-p)
    (if (null sys-pathname-slaves-p)
	(progn
	  ;; no slaves directory was found
	  (put-message-value (_ "found physical device")
			     (directory sys-pathname) :put put)
	  (put-message (_ "-----sys-pathname-slaves-----done-----") :put put)
	  (directory sys-pathname))
      (progn
	(debug-message-value (_ "dir-list-slaves-wild") dir-list-slaves-wild)
	(debug-message-value (_ "sys-pathname-slaves-wild")
			     sys-pathname-slaves-wild)
	(put-message-value (_ "sys-pathname-slaves-found")
			     sys-pathname-slaves-found :put put)
	(if (null sys-pathname-slaves-found)
	    (progn
	      ;; empty slaves directory was found
	      (put-message-value (_ "found physical device") sys-pathname
				 :put put)
	      (put-message (_ "-----sys-pathname-slaves-----done-----") 
			   :put put)
	      (list sys-pathname))
	  (progn
	    ;; non-empty slaves directory was found
	    (put-message (_ "found slaves - recursing") :put put)
	    ;; gather the leaves of the tree
	    (reduce #'append
		    (mapcar #'(lambda (slave) (sys-pathname-slaves  slave
								    :put put))
			    sys-pathname-slaves-found))))))))

(defun assert-internet-access-to-wikimedia-site-p (&key (put nil))
  "Asserting internet access to wikimedia site"
  (assert-internet-access-p *wikimedia-site-xdump* :put put))

(defun assert-physical-memory-if-large-wikipedia-p (&key (put nil))
  "Asserting adequate physical memory"
  (let* ((phys-mem            (os:physical-memory))
	 (language-code-list  (mirror-language-code-list :put put))
	 (large-language-p    (or (mirror-commonswiki-p :put put)
				  (and (intersection
					language-code-list
					*wikimedia-large-language-code-list*
					:test #'string=)
				       t))))
    (put-message-value (_ "detecting")
		       (format-integer-for-human phys-mem) :put put)
    ;; assert if we have one of the largest wiki's
    (put-message-value (_ "our languages are") language-code-list
		       :put put)
    (put-message-value (_ "large languages are")
		       *wikimedia-large-language-code-list*
		       :put put)
    (put-message-value (_ "are any of our languages large") 
		       large-language-p :put put)
    (if large-language-p
	(progn
	  (put-message-value (_ "requiring minimum")
			     (format-integer-for-human
			      *system-physical-memory-min*) :put put)
	  (>= phys-mem *system-physical-memory-min*))
      t)))

(defun warn-if-no-hugepages-allocated-p (&key (put nil))
  "Warning if no hugepages allocated"
  (loop
   for size in (system-hugepage-size-list :put put)
   as  alist    = (system-hugepage-alist size :put put)
   as  total    = (cdr (assoc "nr_hugepages"      alist :test #'equalp))
   as  free     = (cdr (assoc "free_hugepages"    alist :test #'equalp))
   as  reserved = (cdr (assoc "resv_hugepages"    alist :test #'equalp))
   as  surplus  = (cdr (assoc "surplus_hugepages" alist :test #'equalp))
   collect (< free total) into allocated
   do (put-message-value (_ "hugepage size (totat/free/resv)")
			 (format nil "~7d[kB] (~4d/~4d/~4d)"
				 size total free reserved) :put put)
   finally (return (notevery #'null allocated))))

(defun count-cpu (&key (put nil))
  "Counting CPU's"
  ;; number of cpu's useful for determining how many mirror processes
  ;; to run concurrently
  (let* ((directory-list '(:absolute "sys" "devices" "system" "cpu"))
	 (file-name      "present")
	 (cpu-pathname   (make-pathname :directory directory-list
					:name file-name))
	 (cpu-line       nil)
	 (cpus           nil))
    ;; "present" will contain a line like "0-1" (meaning two cpus)
    (with-open-file (f cpu-pathname)
      (setq cpu-line (read-line f)))     ; "0-1"
    (with-input-from-string (s (first    ; "1"
				(last
				 (regexp:regexp-split "-" cpu-line))))
      (setq cpus (1+ (read s))))         ; 2
    (if (and (numberp cpus) (>= cpus *system-cpu-min*))
	(put-message-value-done (_ "number of CPU's found") cpus :put put)
      (progn
	(put-message-value (_ "number of CPU's found") cpus :put put)
	(setq cpus *system-cpu-min*)
	(put-message-value-done (_ "set CPU's to") cpus :put put)))
    (setq *system-cpu* cpus)
    cpus))


;;;;--------------------------------------------------------------------------+
;;;; Assert prerequisite software:                                            |
;;;;--------------------------------------------------------------------------+


(defun assert-clisp-features-p (&key (put nil))
  "Asserting clisp features"
  (assert-test-set-p
   #'(lambda (x) (member x *features*))
   '(:asdf2 :asdf :clisp :clx :common-lisp-controller :gettext
     :i18n :loop :regexp :screen :syscalls)
   :put put))

(defun assert-concurrency-limit-xchunk-p (&key (put nil))
  "Limiting concurrency of importing `x-chunk's"
  (let ((innodb-file-format (sql-show-innodb-file-format :put put)))
    (put-message-value (_ "innodb-file-format") innodb-file-format :put put)
    (setq *mirror-xchunk-concurrency-limit* 
	  (cond ((string= innodb-file-format "Antelope")
		 (put-message (_ "Antelope handles concurrency well") :put put)
		 (put-message-value (_ "choose lesser of number of CPUs or")
				    *system-cpu-max* :put put)
		 (min *system-cpu* *system-cpu-max*))
		((string= innodb-file-format "Barracuda")
		 (put-message (_ "Barracuda does not handle concurrency well - frequent deadlocks") :put put)
		 *system-cpu-min*)
		(t nil)))
    (put-message-value (_ "*mirror-xchunk-concurrency-limit*")
		       *mirror-xchunk-concurrency-limit* :put put))
  *mirror-xchunk-concurrency-limit*)

(defun assert-configuration-files-or-restore-default (&key (put nil))
  "Asserting (or restoring default) configuration files"
  (loop
   initially
     (put-message-start (_ "cd to restore directory")               :put put)
     (ext:cd *whereis-directory-wpmirror-restore*)
     (put-message-value-done (_ "cd to restore directory") (ext:cd) :put put)
   with count-mysql   = 0
   with count-restore = 0
   for (dir-symbol file-symbol) in *wpmirror-config-restore-list* 
   as dir-path     = (symbol-value dir-symbol)
   as file-name    = (symbol-value file-symbol)
   as dummy        = (put-message-value dir-path file-name :put put)
   as path-name    = (merge-pathnames (parse-namestring dir-path)
				      (parse-namestring file-name))
   ;; some file in `restore' directory may be compressed
   ;; in which case, we copy and decompress
   as file-name-gz = (format nil "~a.gz" file-name)            
   as path-name-gz = (merge-pathnames (parse-namestring dir-path)
				      (parse-namestring file-name-gz))
   when (null (file-exists-p path-name :put put))
   do (cond ((file-exists-p file-name :put put)
	     (put-flag-message-value :info (_ "restoring default") path-name)
	     (shell-copy-file file-name dir-path :put put))
	    ((file-exists-p file-name-gz :put put)
	     (put-flag-message-value :info (_ "restoring default") path-name)
	     (shell-copy-file file-name-gz dir-path :put put)
	     (ext:cd dir-path)
	     (shell-gunzip file-name-gz :put put)
	     (ext:cd *whereis-directory-wpmirror-restore*))
	    (t
	     (put-flag-message-value :info (_ "not restoring") path-name)))
   ;; if `LocalSettings*' restored, then chown and chmod
   and do (when (and (string= dir-path *whereis-directory-mediawiki-config*)
		     (file-exists-p path-name :put put))
	    (shell-chown path-name :owner "www-data:www-data" :put put)
	    (shell-chmod path-name :permissions "600"         :put put))
   ;; if `favicon.ico' restored, then chown
   and do (when (and (string= dir-path *whereis-directory-mediawiki*)
		     (file-exists-p path-name :put put))
	    (shell-chown path-name :owner "www-data:www-data" :put put))
   ;; if `wp-mirror.cnf' restored, then see finally clause
   and do (when (string= dir-path *whereis-directory-mysql-config-conf.d*)
	    (incf count-mysql))
   and do (incf count-restore)
   finally
     (put-message-start (_ "cd to working directory")               :put put)
     (ext:cd *whereis-directory-wpmirror-working*)
     (put-message-value-done (_ "cd to working directory") (ext:cd) :put put)
     ;; if `wp-mirror.cnf' was restored, then restart `mysqld'
     (when (> count-mysql 0)   (shell-mysql-restart :put put))
     (when (> count-restore 0) (put-flag-message :info (_ "done"))))
  ;;
  ;; Design note:
  ;;
  ;; To get math equations formatted with `TeX', we need to create link:
  ;;   `/var/lib/wp-mirror-mediawiki/extensions/Math/math/texvc' ->
  ;;   `/usr/bin/wp-mirror-texvc'
  ;; To get math equations formatted with `MathJax', we need to create link:
  ;;   `/var/lib/wp-mirror-mediawiki/extensions/Math/texvccheck/texvccheck' ->
  ;;   `/usr/bin/wp-mirror-texvccheck'
  ;;
  (loop
   ;;  (symbol     symbol       string   )    list-of-lists
   for (target-sym link-dir-sym link-name) in *mediawiki-extension-link-list* 
   as target    = (symbol-value target-sym)
   as link-dir  = (symbol-value link-dir-sym)
   do
   (shell-ln target link-dir link-name :put put))
  t)


;;;;--------------------------------------------------------------------------+
;;;; Assert DBMS credentials:                                                 |
;;;;--------------------------------------------------------------------------+

(defun assert-dbms-accounts-p (&key (put nil))
  "Asserting DBMS user accounts `wikiadmin' and `wikiuser'"
  (let* ((select-admin (concatenate 'string
			   "SELECT host,user,password FROM mysql.user "
			   (format nil "WHERE user='~a';" *db-wikiadmin-user*)))
	 (select-user  (concatenate 'string
			   "SELECT host,user,password FROM mysql.user "
			   (format nil "WHERE user='~a';" *db-wikiuser-user*)))
	 (result-admin (query-database-and-return-list-of-lists 
			select-admin :user *db-debian-user* :put  put))
	 (result-user  (query-database-and-return-list-of-lists 
			select-user  :user *db-debian-user* :put  put)))
    (sql-select-mysql-user :put put)
    (and result-admin result-user)))

(defun create-dbms-accounts (&key (put nil))
  "Creating DBMS user accounts for `wikiadmin' `wikiuser'"
  (let ((password nil))
    ;; wikiadmin
    (setq password     (sql-encrypt-current-timestamp :put put))
    (put-message-value (_ "wikiadmin password") password :put put)
    (defparameter      *db-wikiadmin-password*  password)
    (sql-create-user   *db-wikiadmin-user* *db-wikiadmin-password* :put put)
    (sleep 1) ; otherwise same timestamp --> same passwords
    ;; wikiuser
    (setq password     (sql-encrypt-current-timestamp :put put))
    (put-message-value (_ "wikiuser password")  password :put put)
    (defparameter      *db-wikiuser-password*   password)
    (sql-create-user   *db-wikiuser-user*  *db-wikiuser-password* :put put)
    (sleep 1) ; otherwise same timestamp --> same passwords
    ))

(defun assert-dbms-accounts-or-create-p (&key (put nil))
  "Asserting or creating DBMS user accounts `wikiadmin' and `wikiuser'"
  (let ((path-name (merge-pathnames
		    (parse-namestring *whereis-directory-mediawiki-config*)
		    (parse-namestring
		     *whereis-file-mediawiki-config-localsettings-account*))))
    (if (and (assert-dbms-accounts-p  :put put)
	     (file-exists-p path-name :put put)
	     (eql (shell-cat-grep-wc (format nil "~:a" path-name) "." :put put)
		  *mediawiki-config-localsettings-account-lines*))
	(put-message (_ "DBMS accounts for 'wikiadmin' and 'wikiuser' exist")
		     :put put)
      (progn
	(assert-dbms-drop-accounts-p                 :put put)
	(create-dbms-accounts                        :put put)
	(create-file-mediawiki-localsettings-account :put put)))
    (and (assert-dbms-accounts-p  :put put)
	 (file-exists-p path-name :put put))))

(defun assert-dbms-connect-with-credentials-debian-p (&key (put nil))
  "Asserting access to DBMS with debian credentials"
  (when (null (sql-show-databases :user *db-debian-user* :put put))
    (sql-create-user-debian *db-debian-password* :put put)
    (sleep 1)
    (sql-grant-all-to-debian :put put)
    (sleep 1))
  (not (null (sql-show-databases :user *db-debian-user* :put put))))

(defun assert-dbms-connect-with-credentials-root-p (&key (put nil))
  "Asserting access to DBMS with root credentials"
  (not (null (sql-show-databases :user *db-root-user* :put put))))

(defun assert-dbms-connect-with-credentials-wikiadmin-p (&key (put nil))
  "Asserting access to DBMS with wikiadmin credentials"
  (not (null (sql-show-databases :user *db-wikiadmin-user* :put put))))

(defun assert-dbms-connect-with-credentials-wikiuser-p (&key (put nil))
  "Asserting access to DBMS with wikiuser credentials"
  (not (null (sql-show-databases :user *db-wikiuser-user* :put put))))

(defun assert-dbms-credentials-debian-p (&key (put nil))
  "Asserting DBMS credentials for `debian-sys-maint' account"
  (not (or (null *db-debian-user*)
	   (null *db-debian-password*))))

(defun scrape-dbms-credentials-debian (&key (put nil))
  "Scraping DBMS credentials for `debian-sys-maint' account"
  (let ((path-name (merge-pathnames
		    (parse-namestring *whereis-directory-mysql-config*)
		    (parse-namestring *whereis-file-mysql-config-debian*))))
    (when (assert-file-exists-p path-name :put put)
      (defparameter *db-debian-user*     
	(parse-file-key path-name "user"     :put put))
      (defparameter *db-debian-password* 
	(parse-file-key path-name "password" :put put)))))

(defun assert-dbms-credentials-debian-or-scrape-p (&key (put nil))
  "Asserting or scraping DBMS credentials for `debian-sys-maint' account"
  (when (null (assert-dbms-credentials-debian-p :put put))
    (scrape-dbms-credentials-debian :put put))
  (assert-dbms-credentials-debian-p :put put))
      
(defun assert-dbms-credentials-p (&key (put nil))
  "Asserting DBMS credentials for `wikiadmin' and `wikiuser'"
  (not (or (null *db-wikiadmin-user*)
	   (null *db-wikiadmin-password*)
	   (null *db-wikiuser-user*)
	   (null *db-wikiuser-password*))))

(defun scrape-dbms-credentials (&key (put nil))
  "Scraping DBMS credentials for `wikiuser' account"
  (let ((path-name (merge-pathnames
		(parse-namestring *whereis-directory-mediawiki-config*)
		(parse-namestring
		 *whereis-file-mediawiki-config-localsettings-account*)))
	(result    nil))
    (when (assert-file-exists-p path-name :put put)
      (setq result (parse-file-key path-name "$wgDBadminuser"     :put put))
      (when result (defparameter *db-wikiadmin-user*     result))
      (setq result (parse-file-key path-name "$wgDBadminpassword" :put put))
      (when result (defparameter *db-wikiadmin-password* result))
      (setq result (parse-file-key path-name "$wgDBuser"          :put put))
      (when result (defparameter *db-wikiuser-user*     result))
      (setq result (parse-file-key path-name "$wgDBpassword"      :put put))
      (when result (defparameter *db-wikiuser-password* result)))))

(defun assert-dbms-credentials-or-scrape-p (&key (put nil))
  "Scraping DBMS credentials for `wikiadmin' and `wikiuser' accounts"
  (when (null (assert-dbms-credentials-p :put put))
    (scrape-dbms-credentials :put put))
  (assert-dbms-credentials-p :put put))

(defun assert-dbms-drop-accounts-p (&key (put nil))
  "Dropping DBMS `wikiadmin' and `wikiuser' accounts"
  (let* ((accounts-p       (assert-dbms-accounts-p :put put))
	 (grant-admin-list (when accounts-p
			     (sql-show-grants *db-wikiadmin-user* :put put)))
	 (grant-user-list  (when accounts-p
			     (sql-show-grants *db-wikiuser-user*  :put put))))
    (when accounts-p
      (dolist (grant grant-admin-list nil)
	(put-message grant :put put))
      (dolist (grant grant-user-list  nil)
	(put-message grant :put put))
      (when (not (null grant-admin-list))
	(sql-drop-user *db-wikiadmin-user* :put put))
      (when (not (null grant-user-list))
	(sql-drop-user *db-wikiuser-user* :put put)))
  (null (assert-dbms-accounts-p :put put))))

(defun assert-dbms-grant-for-wikiadmin-p (&key (put nil))
  "Granting DBMS privileges on databases to `wikiadmin'"
  (let* ((mirror-wiki-list (set-mirror-wiki-list :put put)))
    (sql-grant-global-to-wikiadmin                             :put put)
    (sql-grant-all-on-database-to-wikiadmin *db-name*          :put put)
    (sql-grant-all-on-database-to-wikiadmin *db-wpmirror-name* :put put)
    (loop
     for wiki          in mirror-wiki-list
     as  database-name  = (wiki-to-database-name wiki :put put)
     do (sql-grant-all-on-database-to-wikiadmin database-name :put put)))
  t)

(defun assert-dbms-grant-for-wikiuser-p (&key (put nil))
  "Granting DBMS privileges on databases to `wikiuser'"
  (let* ((mirror-wiki-list (set-mirror-wiki-list :put put)))
    (sql-grant-siud-on-database-to-wikiuser *db-name* :put put)
    (sql-grant-siud-on-database-to-wikiuser *db-wpmirror-name* :put put)
    (loop
     for wiki          in mirror-wiki-list
     as  database-name  = (wiki-to-database-name wiki :put put)
     do (sql-grant-siud-on-database-to-wikiuser database-name :put put)))
  t)

(defun assert-dbms-mysql-p (&key (put nil))
  "Asserting DBMS is MySQL"
  (string= *db-type* "mysql"))

(defun assert-dbms-mysql-install-db-p (&key (put nil))
  "Asserting MySQL data directory `/var/lib/mysql/'"
  (let ((path-conf (merge-pathnames
		    (parse-namestring *whereis-directory-mysql-config-conf.d*)
		    (parse-namestring *whereis-file-mysql-config-wpmirror*))))
    (when (not (ext:probe-directory *whereis-directory-mysql-datadir*))
      (when (probe-file path-conf)
	(delete-file path-conf))
      (shell-mysql-install-db :put t)))
  (ext:probe-directory *whereis-directory-mysql-datadir*))

(defun assert-dbms-mysql-config-debian-p (&key (put nil))
  "Asserting mysql `/etc/mysql/debian.cnf'"
  (let ((path-my (merge-pathnames
		  (parse-namestring *whereis-directory-mysql-config*)
		  (parse-namestring *whereis-file-mysql-config-debian*))))
    (assert-file-exists-p path-my :put put)))

(defun assert-dbms-time-zone-name-p (&key (time-zone "UTC") (put nil))
  "Asserting DBMS time zone tables have a given timezone"
  (let ((message (_ "looking for time-zone"))
	(result  nil))
    (put-message-value message time-zone :put put)
    (setq result (sql-select-time-zone-name time-zone :put put))
    (if (null result)
	(put-message-value message time-zone)
      (put-message-value-done message time-zone :put put))
    result))

(defun assert-dbms-time-zone-or-load (&key (put nil))
  "Asserting or loading time zone data in DBMS"
  (let ((found-p (assert-dbms-time-zone-name-p :put put))
	(message (_ "loading time zone info")))
    (when (null found-p)
      (put-message-start message :put put)
      (shell-mysql-tzinfo-to-sql-load-database :put put)
      (sleep-until #'assert-dbms-time-zone-name-p :put put)
      (put-flag-message :info (_ "loaded time-zone tables"))
      (put-flag-message :done (_ "done")))
    (or found-p (assert-dbms-time-zone-name-p :put put))))

(defun assert-dbms-up-p (&key (put nil))
  "Asserting DBMS is up"
  (null (shell-mysqladmin-ping :put put)))

(defun assert-search-up-p (&key (put nil))
  "Asserting `elasticsearch' server is up"
  (null (shell-elasticsearch-ping :put put)))

(defun create-file-mediawiki-localsettings-account (&key (put nil))
  "Creating /etc/wp-mirror-mediawiki/LocalSettings_account.php'"
  (let ((path-name (merge-pathnames
   (parse-namestring *whereis-directory-mediawiki-config*)
   (parse-namestring *whereis-file-mediawiki-config-localsettings-account*)))
	(file-permissions     "600"))
    (put-message-value (_ "creating file") path-name :put put)
    (with-open-file (s path-name 
		       :direction :output
		       :if-exists :supersede)
		    (format s "<?php~%")
		    (format s "# Automatically generated by WP-MIRROR for MediaWiki scripts. DO NOT TOUCH!~%")
		    (format s "$wgDBadminuser      = '~a';~%"
			    *db-wikiadmin-user*)
		    (format s "$wgDBadminpassword  = '~a';~%"
			    *db-wikiadmin-password*)
		    (format s "$wgDBuser           = '~a';~%"
			    *db-wikiuser-user*)
		    (format s "$wgDBpassword       = '~a';~%"
			    *db-wikiuser-password*))
    ;; chown www-data:wwwdata
    (shell-chown path-name :put put)
    ;; chmod 600
    (shell-chmod path-name :permissions file-permissions :put put)))

(defun assert-mediawiki-favicon-p (&key (put nil))
  "Asserting mediawiki `favicon.ico' settings"
  (let* ((path-name (merge-pathnames
	     (parse-namestring *whereis-directory-mediawiki*)
	     (parse-namestring *whereis-file-mediawiki-favicon*)))
	 (result    (assert-file-exists-p path-name :put put)))
    (unless (null result)
      ;; chown www-data:wwwdata
      (shell-chown path-name :put put))
    result))

(defun assert-mediawiki-logo-p (&key (put nil))
  "Asserting mediawiki `wp-mirror.png' settings"
  (let* ((path-name (merge-pathnames
	     (parse-namestring *whereis-directory-mediawiki*)
	     (parse-namestring *whereis-file-mediawiki-logo*)))
	 (result    (assert-file-exists-p path-name :put put)))
    (unless (null result)
      ;; chown www-data:wwwdata
      (shell-chown path-name :put put))
    result))

(defun assert-mediawiki-rights-p (&key (put nil))
  "Asserting mediawiki `somerights20.png' settings"
  (let* ((path-name (merge-pathnames
	     (parse-namestring *whereis-directory-mediawiki-licenses*)
	     (parse-namestring *whereis-file-mediawiki-rights*)))
	 (result    (assert-file-exists-p path-name :put put)))
    result))

(defun assert-mediawiki-localsettings-p (&key (put nil))
  "Asserting mediawiki local settings"
  (let* ((path-name (merge-pathnames
	     (parse-namestring *whereis-directory-mediawiki-config*)
	     (parse-namestring *whereis-file-mediawiki-config-localsettings*)))
	 (result    (assert-file-exists-p path-name :put put))
	 (file-permissions     "600"))
    (unless (null result)
      ;; chown www-data:wwwdata
      (shell-chown path-name :put put)
      ;; chmod 600
      (shell-chmod path-name :permissions file-permissions :put put))
    result))

(defun assert-mediawiki-localsettings-account-p (&key (put nil))
  "Asserting mediawiki local settings for database accounts"
  (let* ((path-name (merge-pathnames
		(parse-namestring *whereis-directory-mediawiki-config*)
		(parse-namestring
		 *whereis-file-mediawiki-config-localsettings-account*)))
	 (result    (assert-file-exists-p path-name :put put))
	 (file-permissions     "600"))
    (unless (null result)
      ;; chown www-data:wwwdata
      (shell-chown path-name :put put)
      ;; chmod 600
      (shell-chmod path-name :permissions file-permissions :put put))
    result))

(defun assert-mediawiki-all-dblist-p (&key (put nil))
  "Asserting mediawiki settings for WMF"
  (let* ((path-name (merge-pathnames
		(parse-namestring *whereis-directory-mediawiki-config*)
		(parse-namestring
		 *whereis-file-mediawiki-config-all-dblist*)))
	 (result    (assert-file-exists-p path-name :put put))
	 (file-permissions     "600"))
    (unless (null result)
      ;; chown www-data:wwwdata
      (shell-chown path-name :put put)
      ;; chmod 600
      (shell-chmod path-name :permissions file-permissions :put put))
    result))

(defun assert-mediawiki-initialisesettings-p (&key (put nil))
  "Asserting mediawiki settings for WMF"
  (let* ((path-name (merge-pathnames
		(parse-namestring *whereis-directory-mediawiki-config*)
		(parse-namestring
		 *whereis-file-mediawiki-config-initialisesettings*)))
	 (result    (assert-file-exists-p path-name :put put))
	 (file-permissions     "600"))
    (unless (null result)
      ;; chown www-data:wwwdata
      (shell-chown path-name :put put)
      ;; chmod 600
      (shell-chmod path-name :permissions file-permissions :put put))
    result))

(defun assert-mediawiki-localsettings-wpmirror-p (&key (put nil))
  "Asserting mediawiki local settings for wp-mirror"
  (let* ((path-name (merge-pathnames
		(parse-namestring *whereis-directory-mediawiki-config*)
		(parse-namestring
		 *whereis-file-mediawiki-config-localsettings-wpmirror*)))
	 (result    (assert-file-exists-p path-name :put put))
	 (file-permissions     "600"))
    (unless (null result)
      ;; chown www-data:wwwdata
      (shell-chown path-name :put put)
      ;; chmod 600
      (shell-chmod path-name :permissions file-permissions :put put))
    result))

(defun assert-php-xdebug-p (&key (put nil))
  "Asserting php `xdebug.max_nesting_level' setting"
  (let* ((path-name (merge-pathnames
	     (parse-namestring *whereis-directory-php-mods-available*)
	     (parse-namestring *whereis-file-php-xdebug*)))
	 (result    (assert-file-exists-p path-name :put put)))
    (unless (null result)
      (when (null (grep-first-non-comment path-name "xdebug.max_nesting_level"
					  :put put))
	;; append lines to `/etc/php5/mods-available/xdebug.ini'
	(shell-echo "; configured by WP-MIRROR" path-name :put put)
	(shell-echo (format nil "xdebug.max_nesting_level = ~d"
			    *mediawiki-php-xdebug-max-nesting-level*)
		    path-name :put put)
	;; restart `apache2' server
	(shell-apache2-restart :put put)))
    result))

(defun parse-file-mediawiki-config-localsettings (key &key (put nil))
  "Parsing mediawiki local settings for `key = value'"
  (let* ((path-name-1 (merge-pathnames
		       (parse-namestring *whereis-directory-mediawiki-config*)
		       (parse-namestring
			*whereis-file-mediawiki-config-localsettings*)))
	 (path-name-2 (merge-pathnames
		       (parse-namestring *whereis-directory-mediawiki-config*)
		       (parse-namestring
		       *whereis-file-mediawiki-config-localsettings-account*)))
	 (path-name-3 (merge-pathnames
		       (parse-namestring *whereis-directory-mediawiki-config*)
		       (parse-namestring
		       *whereis-file-mediawiki-config-localsettings-wpmirror*)))
	(path-name-list (list path-name-1 path-name-2 path-name-3))
	(temp           nil)
	(result         nil))
    (if (member key '("$wgDBadminuser" "$wgDBadminpassword"
		      "$wgDBuser" "$wgDBpassword") :test #'string=)
	(setq result (parse-file-key path-name-2 key :put put))
      (dolist (path-name path-name-list result)
	(setq temp (parse-file-key path-name key :put put))
	(when temp (setq result temp))))))

(defun parse-file-mysql-config-debian (key &key (put nil))
  "Parsing '/etc/mysql/debian.cnf' for `key = value'"
  (let ((path-name (merge-pathnames
		    (parse-namestring *whereis-directory-mysql-config*)
		    (parse-namestring *whereis-file-mysql-config-debian*))))
    (parse-file-key path-name key :put put)))

(defun parse-file-key (path-name key &key (put nil))
  "Parsing path-name for `key = value'"
  (let* ((l        (grep-last-non-comment path-name
					  (format nil "~a[ ]*=" key)))
	 (m        (format nil "probing ~a" key))
	 (rhs      nil)
	 (val-type nil)
	 (val      nil))
    (if (null l)
	(put-message m)
      (progn
	(setq rhs (second (regexp:regexp-split "=" l))) ; right-hand side
	;; rhs can be `"foo";' (where foo is a string)
	;; rhs can be  `foo;'  (where foo is `true', `false', numeric)
	(if (regexp:match "['\"]" rhs)
	    (setq val-type :string)
	  (setq val-type :other))
	(case val-type
	      (:string (setq val (second (regexp:regexp-split "['\"]" rhs))))
	      (:other  (setq val (string-trim
				  '(#\Space #\Tab #\Newline)
				  (first  (regexp:regexp-split ";"  rhs))))))
	(if (regexp:match "password" key)
	    (put-message-value m "********" :put put)
	  (put-message-value m val :put put))))
    val))

(defun put-dbms-credentials (&key (put nil))
  "Putting DBMS credentials"
  (put-message-value "*db-type*"   *db-type*     :put put)
  (put-message-value "*db-server*" *db-server*   :put put)
  (put-message-value "*db-name*"   *db-name*     :put put)
  (put-message-value "*db-debian-user*"
		     *db-debian-user*    :put put)
  (put-message-value "*db-debian-password*"
		     (if *db-debian-password*    "********" nil) :put put)
  (put-message-value "*db-root-user*"
		     *db-root-user*      :put put)
  (put-message-value "*db-root-password*"
		     (if *db-root-password*      "********" nil) :put put)
  (put-message-value "*db-wikiadmin-user*"
		     *db-wikiadmin-user* :put put)
  (put-message-value "*db-wikiadmin-password*"
		     (if *db-wikiadmin-password* "********" nil) :put put)
  (put-message-value "*db-wikiuser-user*"
		     *db-wikiuser-user*  :put put)
  (put-message-value "*db-wikiuser-password*"
		     (if *db-wikiuser-password*  "********" nil) :put put))

(defun warn-if-dbms-root-account-has-no-password (&key (put nil))
  "Warning if DBMS root account has no password"
  (let* ((select (concatenate 'string
			      "SELECT host,user,password FROM mysql.user "
			      "WHERE user='root' AND password='';"))
	 (result (query-database-and-return-list-of-lists select
					    :user *db-debian-user*
					    :put  put)))
    (debug-message result)
    (null result)))

(defun warn-if-dbms-has-anonymous-user-account (&key (put nil))
  "Warning if DBMS has any anonymous user accounts"
  (let* ((select "SELECT host,user,password FROM mysql.user WHERE user='';")
	 (result (query-database-and-return-list-of-lists select
					    :user *db-debian-user*
					    :put  put)))
    (debug-message result)
    (null result)))

(defun warn-if-dbms-has-root-accounts-accessible-from-outside-localhost (&key (put nil))
  "Warning if DBMS has root accounts accessible from outside localhost"
  (let* ((select (concatenate 'string
			      "SELECT host,user,password FROM mysql.user "
			      "WHERE user='root' AND host NOT IN "
			      "('localhost', '127.0.0.1', '::1');"))
	 (result (query-database-and-return-list-of-lists select
					    :user *db-debian-user*
					    :put  put)))
    (debug-message result)
    (null result)))

(defun warn-if-dbms-has-test-database (&key (put nil))
  "Warning if DBMS has test database"
  (let* ((show   "SHOW DATABASES LIKE 'test%';")
	 (result (query-database-and-return-list-of-strings show
					    :user *db-debian-user*
					    :put  put)))
    (debug-message-value show result)
    (null result)))

(defun warn-if-search-server-down-p (&key (put nil))
  "Warning if `elasticsearch' server is down"
  (let* ((result (shell-elasticsearch-ping :put put)))
    (debug-message result)
    (null result)))


;;;;--------------------------------------------------------------------------+
;;;; Assert more prerequisite software:                                       |
;;;;--------------------------------------------------------------------------+

(defun assert-database-p (database-name &key (put nil))
  "Asserting database-name exists"
  (let ((database-list (sql-show-databases :user *db-debian-user* :put put))
	(result        nil))
    (put-message-value (_ "database list") database-list :put put)
    (setq result (not (null (member database-name database-list
				    :test #'string=))))
    (if result
	(put-message-value-done (_ "assert database") database-name :put put)
      (put-message-value-fail (_ "assert database") database-name :put put))
    result))

(defun assert-database-dump-p (database-name &key (put nil))
  "Asserting database dump file"
  (let* ((message      (_ "database dump-file"))
	 (file-name    (database-name-to-database-dump-file-name database-name
								 :put put))
	 (path-name    (merge-pathnames 
			(parse-namestring *whereis-directory-wpmirror-working*)
			(parse-namestring file-name)))
	 (result       (file-exists-p path-name :put put)))
    (if result
	(put-message-value-done message database-name :put put)
      (put-message-value-fail message database-name :put put))
    result))

(defun assert-database-table-p (database-name table-name &key (put nil))
  "Asserting database table exists"
  (let* ((message          (_ "database table"))
	 (long-name        (format nil "~a.~a" database-name table-name))
	 (database-exist-p (assert-database-p database-name :put put))
	 (tables-found     nil)
	 (result           nil))
    (when database-exist-p
      (setq tables-found (sql-select-schema-tables-table-name
			  database-name :put put))
      (setq result (not (null
			 (member table-name tables-found :test #'string=)))))
    (if result
	(put-message-value-done message long-name :put put)
      (put-message-value-fail message long-name :put put))
    result))

(defun assert-database-has-at-least-one-table-p (database-name &key (put nil))
  "Asserting database exists and has at least one table"
  (let* ((exist-p (assert-database-p database-name :put put))
	 (count   0))
    (if (null exist-p)
	(put-message-value-fail (_ "database not found") database-name :put put)
      (setq count (sql-select-schema-count-tables database-name :put put)))
    (put-message-value (_ "number of tables") count :put put)
    (> count 0)))

(defun assert-database-template-p (&key (put nil))
  "Asserting database template for `wikidb'"
  (let ((template-path  (merge-pathnames
			 (parse-namestring
			  *whereis-directory-mediawiki-maintenance*)
			 (parse-namestring
			  *whereis-file-mediawiki-farm-database*))))
    (file-exists-p template-path :put put)))

(defun assert-database-template-or-dump (&key (put nil))
  "Asserting or creating a `mysqldump' of `wikidb'"
  (let* ((message-found  (_ "database template found"))
	 (message-dump   (_ "dumping database to make template"))
	 (file-path      (merge-pathnames
			  (parse-namestring
			   *whereis-directory-mediawiki-maintenance*)
			  (parse-namestring
			   *whereis-file-mediawiki-farm-database*)))
	 (result         nil))
    (if (file-exists-p file-path :put put)
	(put-message message-found :put put)
      (progn
	(put-message-start message-dump :put put)
	(setq result (shell-mysqldump-to-file *db-name* file-path :put put))
	(if (null result)
	    (put-message-done message-dump :put put)
	  (put-message-fail-and-abort message-dump))))
    (file-exists-p file-path :put put)))

(defun assert-database-wikidb-p (&key (put nil))
  "Asserting database `wikidb'"
  (assert-database-p *db-name* :put put))

(defun assert-database-wikidb-or-load (&key (put nil))
  "Asserting or loading `wikidb' database"
  (let ((template-path (merge-pathnames
		   (parse-namestring *whereis-directory-mediawiki-maintenance*)
		   (parse-namestring *whereis-file-mediawiki-farm-database*))))
    (put-message template-path :put put)
    (assert-database-or-load *db-name* template-path :put put)))

(defun assert-database-template-and-wikidb-p (&key (put nil))
  "Asserting database template and `wikidb' or die"
  (let ((template-p  (assert-database-template-p :put put))
	(wikidb-p    (assert-database-wikidb-p :put put))
	(result      nil))
    (put-message-value "template-p" template-p :put put)
    (put-message-value "wikidb-p"   wikidb-p   :put put)
    ;; missing wikidb, load wikidb from template
    (when (and template-p (null wikidb-p))
      (assert-database-wikidb-or-load :put put)
      (setq result t))
    ;; missing template, dump wikidb to template
    (when (and (null template-p) wikidb-p)
      (assert-database-template-or-dump :put put)
      (setq result t))
    ;; have both, do nothing
    (when (and template-p wikidb-p)
      (setq result t))
    result))

(defun assert-database-wpmirror-p (&key (put t))
  "Asserting database `wpmirror'"
  (assert-database-p *db-wpmirror-name* :put put))

(defun assert-database-wpmirror-or-create-p (&key (put nil))
  "Asserting database `wpmirror' or create it"
  ;; 1) assert or create database
  (if (assert-database-wpmirror-p :put put)
      (put-message-value (_ "database found") *db-wpmirror-name* :put put)
    (progn
      ;; grant privileges
      (put-message-start (_ "granting privileges to *db-wikiuser-user*") :put put)
      (sql-grant-siud-on-database-to-wikiuser *db-wpmirror-name* :put put)
      (put-message-value-done (_ "granting privileges to *db-wikiuser-user*")
			      *db-wikiuser-user* :put put)
      ;; create database
      (create-database-p *db-wpmirror-name* :put put)))
  ;; 2) create and update database schema
  (create-and-update-database-wpmirror-tables-p :put put)
  (assert-database-wpmirror-p :put put))

(defun create-and-update-database-wpmirror-tables-p (&key (put nil))
  "Creating and updating database schema for `wpmirror'"
  ;;
  ;; Design note:
  ;;
  ;; Version history
  ;;
  ;; table      |0.1    0.2    0.5    0.6    0.7.3  0.7.4
  ;; -----------+------+------+------+------+------+------
  ;; `file'     |create alter  alter  alter         alter
  ;; `image'    |       create        drop
  ;; `priority' |                     create
  ;; `time'     |                     create alter
  ;;
  (let* ((tables-found    (sql-select-schema-tables-table-name
			   *db-wpmirror-name* :put put))
	 (clean-install-p (zerop (length tables-found)))
	 (v0.1-p          (and (= (length tables-found) 1)
			       (member "file"     tables-found :test #'string=)
			       ))
	 (v0.2-v0.5-p     (and (= (length tables-found) 2)
			       (member "file"     tables-found :test #'string=)
			       (member "image"    tables-found :test #'string=)
			       ))
	 (v0.6-v0.7-p     (and (= (length tables-found) 3)
			       (member "file"     tables-found :test #'string=)
			       (member "priority" tables-found :test #'string=)
			       (member "time"     tables-found :test #'string=)
			       )))
    ;; 1) v0.1-0.5 - clean install (do not bother to upgrade)
    (when (or clean-install-p v0.1-p v0.2-v0.5-p)
      (progn
	;; database `wpmirror' - drop <=0.5, create latest
	(drop-database-p   *db-wpmirror-name* :put put)
	(create-database-p *db-wpmirror-name* :put put)
	;; tables
	(loop
	 for table in *db-wpmirror-tables*
	 do (create-wpmirror-table-p table :put put))))
    ;; 2) populate `priority' table
    (sql-insert-priority :put put)
    ;; 3) update `time' for v0.7.3
    (when v0.6-v0.7-p
      (upgrade-database-table-wpmirror-time-0.7.3-p :put put)
      (upgrade-database-table-wpmirror-file-0.7.4-p :put put))
    (sleep 1)
    t))

(defun upgrade-database-table-wpmirror-time-0.7.3-p (&key (put nil))
  "Upgrading database schema for `wpmirror.time'"
  (let ((msg              (_ "updating schema to 0.7.3"))
	(msg-done         (_ "already done"))
	(column-name-list (sql-show-column-name-list *db-wpmirror-name* "time"
						     :put put))
	(column-spec-list
	 `("`disk_usage_mysql_datadir` BIGINT UNSIGNED NOT NULL DEFAULT 0"
	   "`disk_usage_working_dir` BIGINT UNSIGNED NOT NULL DEFAULT 0"
	   "`partition_free_images` BIGINT UNSIGNED NOT NULL DEFAULT 0"
	   "`partition_free_innodb` BIGINT UNSIGNED NOT NULL DEFAULT 0")))
    (if (and
	 (member "disk_usage_mysql_datadir"    column-name-list
		 :test #'string=)
	 (member "disk_usage_working_dir"      column-name-list
		 :test #'string=)
	 (member "partition_free_images"       column-name-list
		 :test #'string=)
	 (member "partition_free_innodb"       column-name-list
		 :test #'string=))
	(put-flag-message-value :info msg msg-done)
      (progn
	(put-flag-message-value :info msg "wpmirror.time")
	;; wait until no other TABLE transaction
	(sleep-until-zero #'sql-select-schema-count-innodb-trx "TABLE" :put put)
	(sql-alter-table-add-column *db-wpmirror-name* "time" column-spec-list
				    :put put)
	;; wait until no other TABLE transaction
	(sleep-until-zero #'sql-select-schema-count-innodb-trx "TABLE" :put put)
	(put-flag-message :info (_ "done"))))
    t))

(defun upgrade-database-table-wpmirror-file-0.7.4-p (&key (put nil))
  "Upgrading database schema for `wpmirror.file'"
  (let* ((msg             (_ "updating schema to 0.7.4"))
	 (msg-done        (_ "already done"))
	 (column-list     (sql-show-columns *db-wpmirror-name* "file" :put put))
	 (column-spec-list
	  `("`type` ENUM('database','table','checksum','xdump','xml','xchunk','sdump','sql','schunk','dchunk','xincr','idump','ichunk','images','error') NOT NULL DEFAULT 'error'"))
	 (match-p (loop
		   for row in column-list
		   as  name = (first  row)
		   as  spec = (second row)
		   when (regexp:match "xincr" spec)
		   return t)))
    (if match-p
	(put-flag-message-value :info msg msg-done)
      (progn
	(put-flag-message-value :info msg "wpmirror.file.type")
	;; wait until no other TABLE transaction
	(sleep-until-zero #'sql-select-schema-count-innodb-trx "TABLE" :put put)
	(sql-alter-table-modify-column *db-wpmirror-name* "file"
				       column-spec-list :put put)
	;; wait until no other TABLE transaction
	(sleep-until-zero #'sql-select-schema-count-innodb-trx "TABLE" :put put)
	(put-flag-message :info (_ "done"))))
    t))

(defun create-wpmirror-table-p (table &key (put nil))
  "Creating wp-mirror table and confirming"
  (let ((message               (_ "creating table"))
	(result                nil)) ; t - table created
    (put-message-start message :put put)
    (when (not (member table
			 (sql-show-tables *db-wpmirror-name* :put put)
			 :test #'string=))
      ;; wait until no other TABLE transaction
      (sleep-until-zero #'sql-select-schema-count-innodb-trx "TABLE" :put put)
      ;; create table
      (cond ((string= table "file"    ) (sql-create-table-file     :put put))
	    ((string= table "priority") (sql-create-table-priority :put put))
	    ((string= table "time"    ) (sql-create-table-time     :put put))
	    (t (put-message-value-fail (_ "unknown table") table)))
      ;; wait until no other TABLE transaction 
      (sleep-until-zero #'sql-select-schema-count-innodb-trx "TABLE" :put put))
    (setq result (member table
			 (sql-show-tables *db-wpmirror-name* :put put)
			 :test #'string=))
    ;; confirm that the table exists
    (if result
	(put-message-value-done message table :put put)
      (put-message-value-fail message table))
    result))

(defun assert-database-wiki-table-p (database-name &key (put t))
  "Asserting database `xxwiki' has all its tables"
  (let ((tables-found    (sql-select-schema-tables-table-name
			  database-name  :put put))
	(tables-expected (sql-select-schema-tables-table-name
			  *db-name* :put put))
	(result          nil))
    (if (string= database-name *db-name*)
	(progn
	  (put-message-value (_ "tables found")    tables-found    :put put)
	  (setq result (> (length tables-found) 0)))
      (progn
	(put-message-value (_ "tables found")    tables-found    :put put)
	(put-message-value (_ "tables expected") tables-expected :put put)
	(setq result (and (> (length tables-found) 0)
			  (> (length tables-expected) 0)
			  (>= (length tables-found)
			      (length tables-expected))))))
    result))

(defun assert-database-or-load (database-name template-path &key (put nil))
  "Asserting or loading a database from a dump file"
  ;; assert or create database
  (if (assert-database-p database-name :put put)
      (put-message-value (_ "database found") database-name :put put)
    (create-database-p database-name :put put))
  ;; assert or create tables
  (if (assert-database-wiki-table-p database-name :put put) 
      (put-message (_ "all tables found") :put put)
    (progn
      ;; tables 
      (put-message-start (_ "loading database template") :put put)
      (if (file-exists-p template-path :put put)
	  (progn
	    (put-message-value (_ "database template found") template-path
			       :put put)
	    ;; wait until no other CREATE TABLE transaction
	    (sleep-until-zero
	     #'sql-select-schema-count-innodb-trx "TABLE" :put put)
	    ;; submit CREATE TABLE transactions
	    (shell-mysql-load-dump-file database-name template-path :put put)
	    ;; wait until transaction completes
	    (sleep-until-zero
	     #'sql-select-schema-count-innodb-trx "TABLE" :put put)
	    (put-message-value-done (_ "loading database template for")
				    database-name :put put))
	(put-message-value-fail (_ "database template not found") 
				template-path))))
  ;; assert tables
  (assert-database-has-at-least-one-table-p database-name :put put))

(defun assert-directory-exists-p (directory-name &key (put nil))
  "Asserting directory exists or die"
  (put-message-value (_ "probing directory") directory-name)
  (ext:probe-pathname directory-name))

(defun file-exists-p (file-name &key (put nil))
  "Determining if file exists and not empty."
  (and (ext:probe-pathname file-name)
       (let ((fsize (posix:file-size file-name)))
	 (put-message-value (_ "File size")
			    (format-integer-for-human fsize) :put put)
	 (> fsize 0))))

(defun assert-file-exists-or-create-p (file-name printable-object &key (put t))
  "Asserting file exists, or create it"
  (put-message-value (_ "probing file") file-name :put put)
  (or (ext:probe-pathname file-name)
    (progn
      (put-message-value (_ "creating file") file-name :put put)
      (with-open-file (f file-name
			 :direction :output
			 :if-exists :supersede)
	(prin1 printable-object f))
      (ext:probe-pathname file-name))))

(defun assert-file-exists-p (file-name &key (put t))
  "Asserting file exists and not empty, or die."
  (put-message-value (_ "probing") file-name :put put)
  (file-exists-p file-name :put put))

(defun assert-images-directory-or-create-p (&key (put t))
  "Asserting or creating mediawiki images directory (../images/)"
  (let* ((path-images (pathname-directory *whereis-directory-mediawiki-images*))
	 (path-name   (make-pathname :directory path-images)))
    (ensure-directories-exist path-name)
    (shell-chown path-name :put put)
    (ext:probe-directory path-name)))

(defun warn-if-old-images-directory-p (&key (put t))
  "Warn if old mediawiki images directory (../mediawiki/images/w*)"
  (let* ((path-images (pathname-directory
		       *whereis-directory-mediawiki-images-old*))
	 ;; /var/lib/mediawiki/images/
	 (path-name-0  (make-pathname :directory path-images))
	 ;; /var/lib/mediawiki/images/wikipedia/
	 (path-name-1  (make-pathname
			:directory (append path-images (list "wikipedia"))))
	 ;; /var/lib/mediawiki/images/wiktionary/
	 (path-name-2  (make-pathname
			:directory (append path-images (list "wiktionary"))))
	 ;; /var/lib/mediawiki/images/wp-mirror/
	 (path-name-3  (make-pathname
			:directory (append path-images (list "wp-mirror"))))
	 (path-0-p     (ext:probe-directory path-name-0))
	 (path-1-p     (ext:probe-directory path-name-1))
	 (path-2-p     (ext:probe-directory path-name-2))
	 (path-3-p     (ext:probe-directory path-name-3)))
    (when path-0-p
      (when path-1-p
	(put-flag-message :info
			  (format nil "consider deleting ~a" path-name-1)))
      (when path-2-p
	(put-flag-message :info
			  (format nil "consider deleting ~a" path-name-2)))
      (when path-3-p
	(put-flag-message :info
			  (format nil "consider deleting ~a" path-name-3)))
      (when (or path-1-p path-2-p path-3-p)
	(put-flag-message :done (_ "done"))))
    (or (null path-0-p)
     (and (null path-1-p) (null path-2-p) (null path-3-p)))))

(defun assert-images-sub-directory-or-create-p (project language-code dir
							 &key (put t))
  "Asserting or creating a math directory (../images/wikipedia/simple/<dir>/)"
  (let* ((path-images (pathname-directory *whereis-directory-mediawiki-images*))
	 (path-name   (make-pathname
		       :directory (append 
				   path-images
				   (list project language-code dir)))))
    (ensure-directories-exist path-name)
    (shell-chown-dir path-name :put put)
    (ext:probe-directory path-name)))

(defun assert-images-lilypond-directory-or-create-p (project language-code
							     &key (put t))
  "Asserting or creating a score directory (../images/wikipedia/simple/lilypond/"
  (assert-images-sub-directory-or-create-p project language-code "lilypond"
					   :put put))

(defun assert-images-math-directory-or-create-p (project language-code
							 &key (put t))
  "Asserting or creating a math directory (../images/wikipedia/simple/math/)"
  (assert-images-sub-directory-or-create-p project language-code "math"
					   :put put))

(defun assert-images-thumb-directory-or-create-p (project language-code
							  &key (put t))
  "Asserting or creating a thumb directory (../images/wikipedia/simple/thumb/"
  (assert-images-sub-directory-or-create-p project language-code "thumb"
					   :put put))

(defun assert-images-timeline-directory-or-create-p (project language-code
							     &key (put t))
  "Asserting or creating a thumb directory (../images/wikipedia/simple/timeline/"
  (assert-images-sub-directory-or-create-p project language-code "timeline"
					   :put put))

(defun assert-images-tmp-directory-or-create-p (project language-code
							&key (put t))
  "Asserting or creating a tmp directory (../images/wikipedia/simple/tmp/"
  (assert-images-sub-directory-or-create-p project language-code "tmp"
					   :put put))

(defun assert-mediawiki-dbms-credentials-p (&key (put nil))
  "Asserting mediawiki has DBMS credentials"
  (defparameter *db-type*               
    (parse-file-mediawiki-config-localsettings "$wgDBtype"          :put put))
  (defparameter *db-server* 
    (parse-file-mediawiki-config-localsettings "$wgDBserver"        :put put))
;;  (defparameter *db-name*
;;    (parse-file-mediawiki-config-localsettings "$wgDBname"          :put put))
  (defparameter *db-wikiadmin-user*
    (parse-file-mediawiki-config-localsettings "$wgDBadminuser"     :put put))
  (defparameter *db-wikiadmin-password* 
    (parse-file-mediawiki-config-localsettings "$wgDBadminpassword" :put put))
  (defparameter *db-wikiuser-user* 
    (parse-file-mediawiki-config-localsettings "$wgDBuser"          :put put))
  (defparameter *db-wikiuser-password*  
    (parse-file-mediawiki-config-localsettings "$wgDBpassword"      :put put))
  (notany #'null (list *db-type* *db-server* ; *db-name*
		       *db-wikiadmin-user* *db-wikiadmin-password*
		       *db-wikiuser-user*  *db-wikiuser-password*)))

(defun assert-mediawiki-localsettings-image-p (&key (put nil))
  "Asserting mediawiki localsettings for image file conversion"
  (let ((val-imagemagick (parse-file-mediawiki-config-localsettings
			  "$wgUseImageMagick"       :put put))
	(val-custom      (parse-file-mediawiki-config-localsettings
			  "$wgCustomConvertCommand" :put put))
	(val-svg         (parse-file-mediawiki-config-localsettings
			  "$wgSVGConverter"         :put put)))
    (and 
        val-imagemagick
	val-custom
	val-svg
	(regexp:match *mediawiki-wgUseImageMagick*       val-imagemagick)
	(regexp:match *mediawiki-wgCustomConvertCommand* val-custom)
	(regexp:match *mediawiki-wgSVGConverter*         val-svg))))

(defun assert-mediawiki-localsettings-tidy-p (&key (put nil))
  "Asserting mediawiki localsettings for `tidy'"
  (let ((val (parse-file-mediawiki-config-localsettings
	      "$wgUseTidy" :put put)))
    (and val
	 (regexp:match "true" val))))

(defun assert-test-set-p (test set &key (put nil))
  "Asserting all elements in set pass test"
  (let ((all-pass t))
    (dolist (element set all-pass)
      (let ((result (funcall test element)))
	(setq all-pass (and result all-pass))
	(if result
	    (put-symbol-value-pass element :put put)
	  (put-symbol-value-fail element))))))

(defun assert-utilities-p (&key (put nil))
  "Asserting prerequisite utilities"
  (assert-test-set-p
   #'(lambda (x) (ext:probe-pathname (symbol-value x)))
   '(*whereis-apache2ctl* *whereis-bunzip2* *whereis-bzcat* *whereis-bzip2*
			  *whereis-cat* *whereis-chown* *whereis-chmod*
			  *whereis-convert* *whereis-cp* *whereis-curl*
			  *whereis-env*
			  *whereis-gawk*
			  ;*whereis-gm*
			  *whereis-grep* *whereis-gunzip* *whereis-gzip*
			  *whereis-hdparm*
			  *whereis-identify*
		          ;*whereis-inkscape*
			  *whereis-md5sum*
			  *whereis-lua*
			  *whereis-mv* *whereis-mysql* *whereis-mysqladmin*
			  *whereis-mysqldump*
			  *whereis-openssl*
			  *whereis-php*
			  *whereis-rm* *whereis-rsvg*
			  *whereis-tar* *whereis-texvc* *whereis-texvccheck*
			  *whereis-wget*
			  *whereis-zcat*)
   :put put))

(defun assert-symbolic-link-to-mediawiki-or-create-p (&key (put nil))
  "Asserting symbolic link from `/var/www/w' to `/var/lib/wp-mirror-mediawiki/'"
  (let ((dir-mediawiki (merge-pathnames
			(parse-namestring *whereis-directory-mediawiki*)))
	(file-link     (merge-pathnames
			(parse-namestring *whereis-directory-www*)
			(parse-namestring *whereis-file-symbolic-link-to-mediawiki*)))
	(tarket        nil)
	(link          nil)
	(result        nil))
    ;; 1) see if link exists and goes to correct target
    (multiple-value-setq (target link)
			 (ext:probe-pathname file-link))
    (setq result (and
		  (ext:probe-pathname dir-mediawiki)
		  (ext:probe-pathname file-link)
		  (equal target dir-mediawiki)))
    ;; 2) if not, then create link
    (when (null result)
      (shell-ln *whereis-directory-mediawiki*
		*whereis-directory-www*
		*whereis-file-symbolic-link-to-mediawiki* :put put))
    ;; 3) confirm link exists and goes to correct target
    (multiple-value-setq (target link)
			 (ext:probe-pathname file-link))
    (setq result (and
		  (ext:probe-pathname dir-mediawiki)
		  (ext:probe-pathname file-link)
		  (equal target dir-mediawiki)))
    result))

(defun assert-virtual-host-p (&key (put nil))
  "Asserting virtual host `wp-mirror.site'"
  (and
   (assert-file-exists-p
    (merge-pathnames
     (parse-namestring *whereis-directory-apache-sites-available*)
     (parse-namestring *whereis-file-virtual-host*))
    :put put)
   (assert-file-exists-p
    (merge-pathnames
     (parse-namestring *whereis-directory-apache-sites-enabled*)
     (parse-namestring *whereis-file-virtual-host*))
    :put put)
   (shell-apache2ctl-grep-vhost-p :put put)))

(defun assert-virtual-host-name-resolution-p (&key (put nil))
  "Asserting name resolution for `wp-mirror.site'"
  (let* (;; we need these in /etc/hosts
         (mirror-wiki-list (mirror-wiki-list :put put))
	 (needs   (append
		   (list (format nil "::1 www.~a" *mirror-virtual-host-name*))
                   (loop
		     for wiki          in mirror-wiki-list
		     as  language-code  = (wiki-to-language-code wiki :put put)
		     as  project        = (wiki-to-project       wiki :put put)
		     as  server         = (wiki-to-server        wiki :put put)
		     collect (format nil "::1 ~a" server)
		     when (string= project "wikipedia")
                       collect (format nil "::1 ~a.~a" 
				       language-code
				       *mirror-virtual-host-name*))))
	 ;; we have these in /etc/hosts (pattern <- "site$")
	 (pattern (concatenate 'string
		   (first
		    (last (regexp:regexp-split (regexp:regexp-quote ".")
					       *mirror-virtual-host-name*)))
		   "$"))
	 (haves   (shell-cat-grep *whereis-file-etc-hosts* pattern :put put))
	 ;; diff
	 (missing (set-difference needs haves :test #'string=)))
    ;; 1) needed in /etc/hosts
    (put-message-start (_ "need these host names") :put put)
    (loop
      for need in needs
      do (put-message need :put put))
    (put-message-done (_ "need these host names") :put put)
    ;; 2) have in /etc/hosts
    (put-message-start (format nil "grepping ~a" *whereis-file-etc-hosts*)
		       :put put)
    (loop
      for line in haves
      do (put-message line :put put))
    (put-message-done (format nil "grepping ~a" *whereis-file-etc-hosts*) 
		      :put put)
    ;; 3) missing from /etc/hosts
    (put-message-start (_ "host names missing") :put put)
    (loop
      for line in missing
      do (put-message line :put put))
    (put-message-done (_ "host names missing") :put put)
    ;; 4) autoconfiguring any virtual-hosts that are missing
    (unless (null missing)
      (put-message-start (format nil "appending virtual host names to ~a" 
				 *whereis-file-etc-hosts*) :put put)
      (with-open-file (s *whereis-file-etc-hosts*
			 :direction :output
			 :if-exists :append
			 :if-does-not-exist :error)
	(loop
	  for line in missing
	  do (format s "~a~%" line)
	  (put-message line :put put)
	  (put-flag-message :info
			    (format nil "appending virtual host name '~a' to ~a"
				    line *whereis-file-etc-hosts*))))
      (put-flag-message :done (_ "done")))
    t))

(defun assert-working-directory-or-create-p (&key (put t))
  "Asserting working directory, or create it"
  (when (null (ext:probe-directory *whereis-directory-wpmirror-working*))
    (put-message (_ "working directory not found---creating") :put put)
    (ensure-directories-exist *whereis-directory-wpmirror-working*))
  (ext:cd *whereis-directory-wpmirror-working*)
  (ext:probe-directory *whereis-directory-wpmirror-working*))

(defun release-all-file-semaphores (&key (put nil))
  "Releasing all file semaphores"
  (put-message-start (_ "releasing all file semaphores"))
  (sql-update-file-semaphore-all 1 :put nil)
  (put-message-done (_ "releasing all file semaphores"))
  t)

(defun initialize-system (&key (put nil))
  "Initializing system"
  (process-command-line-arguments-or-die            :put put)
  ;; set *main-mode*
  (set-main-mode-of-operation :put put)
  ;; start logging after `process-command-line-arguments-or-die' to
  ;; avoid cluttering `--help' and `--version'
  (case *main-mode*
	((:add :delete :drop :dump :profile :restore-default :update)
	 (log-test-set        '(log-start)                            :put put)
	 )
	((:first-mirror :next-mirror)
	 (log-test-set        '(log-start)                            :put put)
	 )
	(otherwise nil)) ; do not log `:monitor'
  (put-message (_ "-----initializing-begin-----------------------") :put t)
  (case *main-mode*
	((:add)
	 (log-test-set-or-die '(assert-clisp-features-p
				assert-utilities-p)                   :put put)
	 (log-test-set-or-die '(assert-images-directory-or-create-p
				assert-working-directory-or-create-p) :put put)
	 (log-test-set        '(warn-if-old-images-directory-p)       :put put)
	 (log-test-set-or-die '(assert-dbms-up-p)                     :put put)
	 (log-test-set-or-die '(assert-dbms-mysql-p
				assert-dbms-mysql-install-db-p
				assert-dbms-mysql-config-debian-p)    :put put)
	 (log-test-set-or-die '(assert-dbms-credentials-debian-or-scrape-p
				assert-dbms-connect-with-credentials-debian-p)
			      :put put)
	 (log-test-set-or-die '(assert-dbms-time-zone-or-load)        :put put)
	 (log-test-set-or-die '(assert-configuration-files-or-restore-default
				process-configuration-files-or-die
				put-parameters)			      :put put)
	 (log-test-set-or-die '(select-sites-for-dump-files
				assert-internet-access-to-wikimedia-site-p)
			      :put put)
	 )
	((:delete :drop :dump :update)
	 (log-test-set-or-die '(assert-clisp-features-p
				assert-utilities-p)                   :put put)
	 (log-test-set-or-die '(assert-images-directory-or-create-p
				assert-working-directory-or-create-p) :put put)
	 (log-test-set-or-die '(assert-dbms-up-p)                     :put put)
	 (log-test-set-or-die '(assert-dbms-mysql-p
				assert-dbms-mysql-install-db-p
				assert-dbms-mysql-config-debian-p)    :put put)
	 (log-test-set-or-die '(assert-dbms-credentials-debian-or-scrape-p
				assert-dbms-connect-with-credentials-debian-p)
			      :put put)
	 ;(log-test-set        '(warn-if-search-server-down-p)         :put put)
	 (log-test-set-or-die '(assert-configuration-files-or-restore-default
				process-configuration-files-or-die
				put-parameters)			      :put put)
	 (log-test-set-or-die '(select-sites-for-dump-files
				assert-internet-access-to-wikimedia-site-p)
			      :put put)
	 )
	((:profile :restore-default)
	 (log-test-set-or-die '(assert-dbms-up-p)                     :put put)
	 (log-test-set-or-die '(assert-dbms-mysql-p
				assert-dbms-mysql-install-db-p
				assert-dbms-mysql-config-debian-p)    :put put)
	 (log-test-set-or-die '(assert-dbms-credentials-debian-or-scrape-p
				assert-dbms-connect-with-credentials-debian-p)
			      :put put)
	 ;(log-test-set        '(warn-if-search-server-down-p)         :put put)
	 (log-test-set-or-die '(select-sites-for-dump-files
				assert-internet-access-to-wikimedia-site-p)
			      :put put)
	 )
	((:first-mirror)
	 (log-test-set-or-die '(assert-clisp-features-p
				assert-utilities-p)                   :put put)
	 (log-test-set-or-die '(assert-images-directory-or-create-p
				assert-working-directory-or-create-p) :put put)
	 (log-test-set        '(warn-if-old-images-directory-p)       :put put)
	 (log-test-set-or-die '(assert-dbms-up-p)                     :put put)
	 (log-test-set-or-die '(assert-dbms-mysql-p
				assert-dbms-mysql-install-db-p
				assert-dbms-mysql-config-debian-p)    :put put)
	 (log-test-set-or-die '(assert-dbms-credentials-debian-or-scrape-p
				assert-dbms-connect-with-credentials-debian-p)
			      :put put)
	 (log-test-set-or-die '(assert-dbms-time-zone-or-load)        :put put)
	 ;(log-test-set        '(warn-if-search-server-down-p)         :put put)
	 (log-test-set-or-die '(assert-configuration-files-or-restore-default
				process-configuration-files-or-die
				put-parameters)			      :put put)
	 (log-test-set-or-die '(select-sites-for-dump-files
				assert-internet-access-to-wikimedia-site-p)
			      :put put)
	 )
	((:next-mirror)
	 (log-test-set-or-die '(assert-working-directory-or-create-p) :put put)
	 (log-test-set-or-die '(assert-dbms-credentials-debian-or-scrape-p
				assert-dbms-connect-with-credentials-debian-p)
			      :put put)
	 (log-test-set-or-die '(process-configuration-files-or-die)   :put put)
	 (log-test-set-or-die '(select-sites-for-dump-files
				assert-internet-access-to-wikimedia-site-p)
			      :put put)
	 )
	((:monitor)
	 (log-test-set-or-die '(assert-clisp-features-p
				assert-utilities-p)                   :put put)
	 (log-test-set-or-die '(assert-images-directory-or-create-p
				assert-working-directory-or-create-p) :put put)
	 (log-test-set        '(warn-if-old-images-directory-p)       :put put)
	 (log-test-set-or-die '(assert-dbms-up-p)                     :put put)
	 (log-test-set-or-die '(assert-dbms-mysql-p
				assert-dbms-mysql-install-db-p
				assert-dbms-mysql-config-debian-p)    :put put)
	 (log-test-set-or-die '(assert-dbms-credentials-debian-or-scrape-p
				assert-dbms-connect-with-credentials-debian-p)
			      :put put)
	 (log-test-set-or-die '(assert-dbms-time-zone-or-load)        :put put)
	 (log-test-set-or-die '(assert-configuration-files-or-restore-default
				process-configuration-files-or-die)   :put put)
	 )
	(otherwise nil))
  (put-message (_ "-----initializing-done------------------------") :put put)
  t)

(defun assert-prerequisite-software (&key (put nil))
  "Asserting prerequisite software"
  (put-message (_ "-----asserting-prerequisite-software-begin----") :put t)
  (case *main-mode*
	((:add)
	 (log-test-set-or-die '(assert-dbms-accounts-or-create-p
				assert-dbms-credentials-or-scrape-p
				assert-dbms-connect-with-credentials-wikiadmin-p
				assert-dbms-grant-for-wikiadmin-p)    :put put)
	 (log-test-set-or-die '(assert-dbms-connect-with-credentials-wikiuser-p
				assert-dbms-grant-for-wikiuser-p)     :put put)
	 (log-test-set-or-die '(assert-database-wpmirror-or-create-p
				assert-database-template-and-wikidb-p) :put put)
	 )
	((:delete :drop :dump :profile :restore-default)
	 (log-test-set-or-die '(assert-dbms-accounts-or-create-p
				assert-dbms-credentials-or-scrape-p
				assert-dbms-connect-with-credentials-wikiadmin-p
				assert-dbms-grant-for-wikiadmin-p)     :put put)
	 )
	((:update)
	 (log-test-set-or-die '(assert-dbms-accounts-or-create-p
				assert-dbms-credentials-or-scrape-p
				assert-dbms-connect-with-credentials-wikiadmin-p
				assert-dbms-grant-for-wikiadmin-p)     :put put)
	 (log-test-set-or-die '(assert-database-wpmirror-or-create-p
				assert-database-template-and-wikidb-p) :put put)
	 (log-test-set-or-die '(assert-dbms-connect-with-credentials-wikiuser-p
				assert-dbms-grant-for-wikiuser-p)      :put put)
	 )
	((:first-mirror)
	 (log-test-set-or-die '(assert-dbms-accounts-or-create-p
				assert-dbms-credentials-or-scrape-p
				assert-dbms-connect-with-credentials-wikiadmin-p
				assert-dbms-grant-for-wikiadmin-p)     :put put)
	 (log-test-set-or-die '(assert-dbms-connect-with-credentials-wikiuser-p
				assert-dbms-grant-for-wikiuser-p)      :put put)
	 ;; warn if dbms insecure
	 (log-test-set        '(warn-if-dbms-root-account-has-no-password 
				warn-if-dbms-has-anonymous-user-account 
				warn-if-dbms-has-root-accounts-accessible-from-outside-localhost
				warn-if-dbms-has-test-database)        :put put)
	 (log-test-set-or-die '(assert-database-wpmirror-or-create-p
				assert-database-template-and-wikidb-p) :put put)
	 (log-test-set-or-die '(assert-mediawiki-all-dblist-p
				assert-mediawiki-initialisesettings-p
				assert-mediawiki-localsettings-p
				assert-mediawiki-localsettings-account-p
				assert-mediawiki-localsettings-wpmirror-p)
			      :put put)
	 (log-test-set-or-die '(assert-mediawiki-localsettings-image-p
				assert-mediawiki-localsettings-tidy-p) :put put)
	 (log-test-set-or-die '(assert-mediawiki-favicon-p
				assert-mediawiki-logo-p
				assert-mediawiki-rights-p)             :put put)
	 (log-test-set-or-die '(assert-mediawiki-dbms-credentials-p)   :put put)
	 (log-test-set-or-die '(assert-php-xdebug-p)                   :put put)
	 (log-test-set-or-die '(assert-concurrency-limit-xchunk-p)     :put put)
	 (log-test-set-or-die '(assert-symbolic-link-to-mediawiki-or-create-p)
			      :put put)
	 (log-test-set-or-die '(assert-virtual-host-p)                 :put put)
	 (log-test-set-or-die '(assert-virtual-host-name-resolution-p) :put put)
	 (log-test-set        '(warn-if-detect-proxy)                  :put put)
	 )
	((:next-mirror)
	 (log-test-set-or-die '(assert-dbms-accounts-or-create-p
				assert-dbms-credentials-or-scrape-p
				assert-dbms-connect-with-credentials-wikiadmin-p
				assert-dbms-grant-for-wikiadmin-p)     :put put)
	 (log-test-set-or-die '(assert-dbms-connect-with-credentials-wikiuser-p
				assert-dbms-grant-for-wikiuser-p)      :put put)
	 (log-test-set-or-die '(assert-mediawiki-dbms-credentials-p)   :put put)
	 )
	((:monitor)
	 (log-test-set-or-die '(assert-dbms-accounts-or-create-p
				assert-dbms-credentials-or-scrape-p
				assert-dbms-connect-with-credentials-wikiadmin-p
				assert-dbms-grant-for-wikiadmin-p)    :put put)
	 (log-test-set-or-die '(assert-dbms-connect-with-credentials-wikiuser-p
				assert-dbms-grant-for-wikiuser-p)     :put put)
	 (log-test-set-or-die '(assert-database-wpmirror-or-create-p) :put put)
	 )
	(otherwise nil))
  (put-message (_ "-----asserting-prerequisite-software-done-----") :put put)
  t)

(defun assert-prerequisite-hardware (&key (put nil))
  "Asserting prerequisite hardware"
  (put-message (_ "-----asserting-prerequisite-hardware-begin----") :put t)
  (case *main-mode*
	((:profile :restore-default)
	 )
	((:add :delete :drop :dump :update)
	 )
	((:first-mirror :next-mirror)
	 (log-test-set-or-die '(count-cpu
				assert-disk-space-if-large-wikipedia-p
				assert-physical-memory-if-large-wikipedia-p
				assert-partition-free-images)         :put put)
	 (log-test-set        '(warn-if-disk-space-low-p
				warn-if-database-stored-on-virtual-disk-p)
			      :put put)
	 (log-test-set        '(assert-hdd-write-cache-p)             :put put)
	 (log-test-set        '(warn-if-no-hugepages-allocated-p)     :put put)
	 )
	((:monitor)
	 )
	(otherwise nil))
  (put-message (_ "-----asserting-prerequisite-hardware-done-----") :put put)
  t)

(defun finalize-system (&key (put nil))
  "Finalizing system"
  (put-message (_ "-----finalizing-begin-------------------------") :put t)
  (case *main-mode*
	((:add)
	 (log-test-set        '(assert-virtual-host-name-resolution-p) :put put)
	 )
	((:delete :drop :dump :profile :restore-default :update)
	 )
	((:first-mirror)
	 (log-test-set        '(update-mediawiki-localization-p)      :put put)
	 (log-test-set        '(clear-pidfile)                        :put put)
	 )
	((:next-mirror :monitor)
	 )
	(otherwise nil))
  (put-message (_ "-----finalizing-done--------------------------") :put put)
  (case *main-mode*
	((:add :delete :drop :dump :profile :restore-default :update)
	 (log-test-set        '(log-stop)                             :put put)
	 )
	((:first-mirror :next-mirror)
	 (log-test-set        '(log-stop)                             :put put)
	 )
	(otherwise nil))
  t)


;;;;--------------------------------------------------------------------------+
;;;; Warn user if proxy detected:                                             |
;;;;--------------------------------------------------------------------------+


(defun warn-if-detect-proxy (&key (put t))
  "Warning if see mention of web proxy"
  (let* ((pattern        "[pP][rR][oO][xX][yY]")
	 (message        (_ "proxy config in"))
	 (result-bashrc (grep-first-non-comment *whereis-bashrc* pattern
						:put put))
	 (result-curlrc (grep-first-non-comment *whereis-curlrc* pattern
						:put put))
	 (result-wgetrc (grep-first-non-comment *whereis-wgetrc* pattern
						:put put)))
    (unless (null result-bashrc)
      (put-message-value (format nil "~a ~a" message *whereis-bashrc*) 
			 result-bashrc :put put))
    (unless (null result-curlrc)
      (put-message-value (format nil "~a ~a" message *whereis-curlrc*) 
			 result-curlrc :put put))
    (unless (null result-wgetrc)
      (put-message-value (format nil "~a ~a" message *whereis-wgetrc*)
			 result-wgetrc :put put))
    (if (or result-bashrc result-curlrc result-wgetrc)
	(put-message-done (_ "might have found proxy") :put put)
      (put-message-done (_ "no proxy found") :put put))
    (not (or result-bashrc result-curlrc result-wgetrc))))


;;;;--------------------------------------------------------------------------+
;;;; Determine mode of operation (mirror v. monitor):                         |
;;;;   Mode can be forced by use of command-line options                      |
;;;;     `--gui'     forces monitor mode, first attempting to use GUI         |
;;;;     `--mirror'  forces mirror mode (overriding any monitor options)      |
;;;;     `--monitor' forces monitor mode, first attempting to use GUI         |
;;;;     `--screen'  forces monitor mode, first attempting to use SCREEN      |
;;;;     `--text'    forces monitor mode, using normal text output            |
;;;;  If no options are given, then the PID file routines (below) come into   |
;;;;  play.  1) If no PID file is found, then `wp-mirror' goes into mirror    |
;;;;  mode. 2) If PID file is found (and not stale), then `wp-mirror' goes    |
;;;;  into monitor mode, first attempting to use GUI.                         |
;;;;  This use of PID files is somewhat different from the way daemons (when  |
;;;;  invoked by `/etc/init.d/*') use them.                                   |
;;;;--------------------------------------------------------------------------+


(defun pidfile-exists-p (&key (put nil))
  "Determining if PID file exists.  If so return PID, else NIL"
  (debug-message-start (_ "probing for PID file") :put put)
  (with-open-file (s *whereis-file-wpmirror-pid* :direction :input
		     :if-does-not-exist nil)
    (if s
	(let ((pid (read s)))
	  (debug-message-value (_ "reading value") pid)
	  pid)                  ; return pid
      (progn
	(debug-message (_ "PID file not found"))
	nil))))                	; return nil

(defun proc-exists-p (pid &key (put nil))
  "Determining existence of process with given PID"
  (put-message-value (_ "probing for process with PID") pid :put put)
  (let ((proc-p  (ext:probe-pathname (format nil "/proc/~d" pid))))
    (if proc-p
	(put-message-value-done (_ "probing for process with PID") pid :put put)
      (put-message-value-fail (_ "probing for process with PID") pid :put put))
    proc-p))

(defun first-mirror-exists-p (&key (put nil))
  "Determining if first instance of `wp-mirror' in mirror mode is running."
  (let* ((pid            (pidfile-exists-p :put put))
	 (first-mirror-p (and pid (proc-exists-p pid :put put))))
    (unless first-mirror-p
      (if pid
	  (put-message (_ "PID file found stale - first mirror was probably killed") :put put)
	(put-message (_ "PID file not found") :put put)))
    first-mirror-p))

(defun set-pidfile (&key (put nil))
  "Creating PID file"
  (let ((pid (os:process-id)))
    (put-message-value (_ "my process id is") pid :put put)
    (with-open-file (s *whereis-file-wpmirror-pid* 
		       :direction :output
		       :if-exists :supersede)
    (if s
	(progn
	  (format s "~d~%" pid)
	  (put-message-value-done (_ "creating PID file")
				  *whereis-file-wpmirror-pid*
				  :put put))
      (put-message-fail-and-die (_ "unable to create PID file"))))
    t))

(defun clear-pidfile (&key (put nil))
  "Removing PID file"
  (put-message-start (_ "probing for PID file") :put put)
  (if (ext:probe-pathname *whereis-file-wpmirror-pid*)
      (progn
	(delete-file *whereis-file-wpmirror-pid*)
	(put-message-value-done (_ "removing PID file") 
				*whereis-file-wpmirror-pid*
				:put put))
    (put-message-done (_ "PID file not found") :put put))
  t)

(defun main-mode-mirror-or-monitor (&key (put nil))
  "Determining if this instance of wp-mirror should run in mirror mode
or in monitor mode"
  ;;
  ;; Design note:
  ;;
  ;; Command-line options should override default PID logic.
  ;;
  ;;      mirror cmd-line                         set
  ;; Case exists options   action                 *main-mode*
  ;; ----+------+---------+----------------------+-------------
  ;;  1)    no     none    clear-pid              :first-mirror
  ;;                       set-pidfile
  ;;                       release-all-semaphores
  ;;  2)    no   --mirror  clear-pid              :first-mirror
  ;;                       set-pidfile 
  ;;                       release-all-semaphores
  ;;  3)    no   --monitor   none                 :monitor
  ;;  4)   yes     none      none                 :monitor
  ;;  5)   yes   --mirror    none                 :next-mirror
  ;;  6)   yes   --monitor   none                 :monitor
  ;;
  ;; The options `--gui', `--screen', and `--text', imply `--monitor'.
  ;;
  (put-message-start (_ "determining mode of operation") :put put)
  (let* ((mirror-exists-p (first-mirror-exists-p :put put)))
    (put-message-value (_ "does mirror process exist") mirror-exists-p :put put)
    (put-message-value (_ "does command line force mirror") 
		       *cmd-force-mirror* :put put)
    (put-message-value (_ "does command line force monitor") 
		       *cmd-force-monitor* :put put)
    ;; logic goes here (the six cases mentioned above)
    (setq *main-mode*
	  (cond ((and (not mirror-exists-p)
		      (not *cmd-force-mirror*)
		      (not *cmd-force-monitor*)) :first-mirror)
		((and (not mirror-exists-p)
		      *cmd-force-mirror*)        :first-mirror)
		((and (not mirror-exists-p)
		      (not *cmd-force-mirror*)
		      *cmd-force-monitor*)       :monitor)
		((and mirror-exists-p
		      (not *cmd-force-mirror*)
		      (not *cmd-force-monitor*)) :monitor)
		((and mirror-exists-p
		      *cmd-force-mirror*)        :next-mirror)
		((and mirror-exists-p
		      (not *cmd-force-mirror*)
		      *cmd-force-monitor*)       :monitor)
		(t nil)))
    ;; action goes here
    (case *main-mode*
      (:first-mirror
       (put-message-start (_ "clearing stale PID file") :put put)
       (log-test-set '(clear-pidfile
		       set-pidfile)
		     :put put))
      (:next-mirror
       )
      (:monitor
       )
      (otherwise nil))
    *main-mode*))

(defun set-main-mode-of-operation(&key (put nil))
  "Setting main mode of operation"
  (when (null *main-mode*)
      (setq *main-mode* (main-mode-mirror-or-monitor :put put)))
  (put-flag-message-value :info (_ "set mode of operation to") 
			  (string-upcase *main-mode*))
  *main-mode*)


;;;;--------------------------------------------------------------------------+
;;;; Status utilities:                                                        |
;;;;   State is stored for each file to enable resuming after outage          |
;;;;                                                                          |
;;;;   Globals:                                                               |
;;;;     *input*               - list of valid inputs to finite-state-machine |
;;;;     *state*               - list of valid states                         |
;;;;     *state-transition*    - list of valid state transitions              |
;;;;     *type*                - list of valid file types                     |
;;;;     *type-state-function* - list of functions to be run when a file of a |
;;;;                             given type and state receives the "start"    |
;;;;                             input                                        |
;;;;     *type-state-priority* - prioritized list of type and state (files are|
;;;;                             processed in order of priority)              |
;;;;   Functions:                                                             |
;;;;     fsm-abort             - abort wp-mirror (due to error)               |
;;;;     fsm-boot              - initialize wp-mirror (load `database's)      |
;;;;     fsm-database-checksum - create `checksum' and `table' records        |
;;;;                           - update `database' with `update_farm.php'     |
;;;;     fsm-database-create   - assert or create `database'                  |
;;;;     fsm-database-grant    - grant privileges on `database' to `wikiadmin'|
;;;;     fsm-database-misc     - delete orphans from `page'                   |
;;;;                           - rebuild search indices                       |
;;;;     fsm-file-convert-xml2sql - convert `xchunk' into `schunk's           |
;;;;     fsm-file-count        - count pages and images in `xml' file         |
;;;;     fsm-file-digest       - compute `md5sum' checksum                    |
;;;;     fsm-file-download     - download `checksum' or `xdump' file from WMF |
;;;;     fsm-file-extract      - extract `idump' tarball                      |
;;;;     fsm-file-import-xml   - import `xchunk' into wiki database           |
;;;;     fsm-file-list-missing - list missing image files, generate `ichunk'  |
;;;;     fsm-file-load-insert  - import `schunk',`dchunk' into wiki database  |
;;;;     fsm-file-parse        - extract `xdump' filename from `checksum' file|
;;;;     fsm-file-process-xml  - convert or import `xchunk'                   |
;;;;     fsm-file-remove       - remove unneeded files                        |
;;;;     fsm-file-split-sdump  - split `sdump' into `d/schunk's               |
;;;;     fsm-file-split-sdump-to-dat - split `sdump' into `dchunk's           |
;;;;     fsm-file-split-sdump-to-schunk - split `sdump' into `schunk's        |
;;;;     fsm-file-split-xdump  - split `xdump' into `xchunk's                 |
;;;;     fsm-file-validate     - compare `md5sum' with known value            |
;;;;     fsm-file-wget         - run `wget' using `ichunk' as its input-file  |
;;;;     fsm-images-directory  - create directory tree for image files        |
;;;;     fsm-no-op             - do nothing                                   |
;;;;     fsm-process-file      - invokes appropriate fsm-*                    |
;;;;     fsm-table-add-index   - ADD  secondary indices for give table        |
;;;;     fsm-table-block-size  - set `ROW_FORMAT=COMPRESSED KEY_BLOCK_SIZE=4' |
;;;;     fsm-table-drop-index  - DROP secondary indices for give table        |
;;;;     fsm-transition        - initial state + valid input --> final state  |
;;;;   Functions (obsolete):                                                  |
;;;;     fsm-database-interwiki- insert interlanguage links into `interwiki'  |
;;;;     fsm-database-update   - update `database' with `update_farm.php'     |
;;;;     fsm-file-decompress   - decompress `bz2' file                        |
;;;;     fsm-file-import       - import `xchunk' into wiki database           |
;;;;     fsm-file-scrape       - scrape image file names, generate `ichunk'   |
;;;;     fsm-file-shell        - run `ichunk' shell script to download images |
;;;;     fsm-file-split-sql    - split decompressed `sdump' into `d/schunk's  |
;;;;     fsm-file-split-sql-to-dat- split decompressed `sdump' into `dchunk's |
;;;;     fsm-file-split-sql-to-sql- split decompressed `sdump' into `schunk's |
;;;;     fsm-file-split-xml    - split decompressed `xdump' into `xchunk's    |
;;;;     fsm-images-chown      - chown images to `www-data:www-data'          |
;;;;     fsm-images-count      - count downloaded images                      |
;;;;     fsm-images-rebuild    - import image metadata into wiki database     |
;;;;     fsm-images-validate   - find corrupt files w/ `gm identify -verbose' |
;;;;   Design note:                                                           |
;;;;     finite-state-machine  - graphical representation                     |
;;;;                                                                          |
;;;;    __           __         __           __        __              __     |
;;;;   |  |s        |  |s      |  |s        |  |s     |  |s           |  |sdf |
;;;;   v  |         v  |       v  |         v  |      v  |            v  |    |
;;;; +-----+ d  +-------+ d  +-----+ d  +-------+ d  +----+ d        +-----+  |
;;;; |start|--->|created|--->|valid|--->|pending|--->|done|--------->|error|  |
;;;; +-----+    +-------+    +-----+    +-------+    +----+    __    +-----+  |
;;;;     \            \          \            \         \     |  |s    /      |
;;;;      \f           \f         \f           \f        \f   v  |    /df     |
;;;;       \            \          \            \         \  +----+  /        |
;;;;        ------------------------------------------------>|fail|--         |
;;;;                                                         +----+           |
;;;;                                                                          |
;;;;--------------------------------------------------------------------------+


(defconstant  *input*
  '("start" "done" "fail"))
(defconstant  *state*
  '("start" "created" "valid" "pending" "done" "fail" "error"))
(defconstant  *state-transition*
  ;;  state  +  input ->state
  '(("start"   "start" "start"  ) ;resume
    ("start"   "done"  "created")
    ("start"   "fail"  "fail"   )
    ("created" "start" "created") ;resume
    ("created" "done"  "valid"  )
    ("created" "fail"  "fail"   )
    ("valid"   "start" "valid"  ) ;resume
    ("valid"   "done"  "pending")
    ("valid"   "fail"  "fail"   )
    ("pending" "start" "pending") ;resume
    ("pending" "done"  "done"   )
    ("pending" "fail"  "fail"   )
    ("done"    "start" "done"   ) ;resume
    ("done"    "done"  "done"   ) ;no-op
    ("done"    "fail"  "error"  ) ;should not happen
    ("fail"    "start" "fail"   ) ;resume
    ("fail"    "done"  "fail"   ) ;no-op
    ("fail"    "fail"  "error"  ) ;should not happen
    ("error"   "start" "error"  ) ;should not happen
    ("error"   "done"  "error"  ) ;should not happen
    ("error"   "fail"  "error"  ) ;should not happen
    ))
(defconstant  *type*
  '("database" "table" "checksum"
    "xdump" "xml" "xchunk" 
    "sdump" "sql" "schunk" "dchunk" "xincr"
    "idump" "ichunk" "images"
    "error"))
(defconstant  *fsm-function*
  '(fsm-abort
    fsm-boot
    fsm-database-checksum
    fsm-database-create
    fsm-database-grant
;;    fsm-database-interwiki
    fsm-database-misc
    fsm-database-update
    fsm-file-convert-xml2sql
    fsm-file-count
    fsm-file-decompress 
    fsm-file-digest
    fsm-file-download 
    fsm-file-extract
    fsm-file-import-xml
    fsm-file-list-missing
    fsm-file-load-insert
    fsm-file-parse
    fsm-file-process-xml
    fsm-file-remove
    fsm-file-split-sdump
    fsm-file-split-sql
    fsm-file-split-xdump
    fsm-file-split-xml
    fsm-file-validate
    fsm-file-wget
    fsm-images-directory
    fsm-no-op
    fsm-table-add-index
    fsm-table-block-size
    fsm-table-drop-index
))

(defconstant *fsm-function-needs-delete-objectcache*
  '(fsm-file-load-insert
    fsm-file-import-xml
))

(defconstant *fsm-function-needs-internet-access*
  '(fsm-boot
    fsm-database-update
    fsm-file-download
    fsm-file-wget
))
(defconstant *fsm-function-needs-partition-free-images*
  '(fsm-file-decompress
    fsm-file-download
    fsm-file-extract
    fsm-file-list-missing
    fsm-file-process-xml
    fsm-file-shell
    fsm-file-split-sdump
    fsm-file-split-sql
    fsm-file-split-xdump
    fsm-file-split-xml
    fsm-file-wget
    fsm-images-directory
))
(defconstant *fsm-function-needs-partition-free-innodb*
  '(fsm-database-checksum
    fsm-database-create
    fsm-database-grant
    fsm-database-misc
    fsm-file-load-insert
    fsm-file-process-xml
    fsm-table-add-index
    fsm-table-block-size
    fsm-table-drop-index
))
(defconstant  *type-state-function*
  ;;  type     state     function
  '(("database" "start"   fsm-database-grant    ) ; OK
    ("database" "created" fsm-database-create   ) ; OK
    ("database" "valid"   fsm-database-checksum ) ; OK
    ("database" "pending" fsm-database-misc     ) ; OK 
    ("database" "done"    fsm-no-op             )
    ("database" "fail"    fsm-abort             )
    ("database" "error"   fsm-abort             )
    ("table"    "start"   fsm-table-block-size  ) ; 
    ("table"    "created" fsm-table-drop-index  ) ; 
    ("table"    "valid"   fsm-table-add-index   ) ; 
    ("table"    "pending" fsm-no-op             ) ;
    ("table"    "done"    fsm-no-op             )
    ("table"    "fail"    fsm-abort             )
    ("table"    "error"   fsm-abort             )
    ("checksum" "start"   fsm-file-download     ) ; OK
    ("checksum" "created" fsm-file-digest       ) ; OK
    ("checksum" "valid"   fsm-file-parse        ) ; OK
    ("checksum" "pending" fsm-file-remove       ) ; OK
    ("checksum" "done"    fsm-no-op             )
    ("checksum" "fail"    fsm-abort             )
    ("checksum" "error"   fsm-abort             )
    ("xdump"    "start"   fsm-file-download     )
    ("xdump"    "created" fsm-file-validate     ) ; OK
    ("xdump"    "valid"   fsm-file-split-xdump  )
    ("xdump"    "pending" fsm-file-remove       ) 
    ("xdump"    "done"    fsm-no-op             )
    ("xdump"    "fail"    fsm-abort             )
    ("xdump"    "error"   fsm-abort             )
    ("xml"      "start"   fsm-file-count        ) ; OK
    ("xml"      "created" fsm-no-op             ) ; fsm-file-digest
    ("xml"      "valid"   fsm-file-split-xml    ) ; OK
    ("xml"      "pending" fsm-file-remove       ) ; 
    ("xml"      "done"    fsm-no-op             )
    ("xml"      "fail"    fsm-abort             )
    ("xml"      "error"   fsm-abort             )
    ("xchunk"   "start"   fsm-file-count        )
    ("xchunk"   "created" fsm-file-digest       )
    ("xchunk"   "valid"   fsm-file-process-xml  ) ; OK
    ("xchunk"   "pending" fsm-file-remove       ) ; 
    ("xchunk"   "done"    fsm-no-op             )
    ("xchunk"   "fail"    fsm-abort             )
    ("xchunk"   "error"   fsm-abort             )
    ("sdump"    "start"   fsm-file-download     )
    ("sdump"    "created" fsm-file-validate     )
    ("sdump"    "valid"   fsm-file-split-sdump  )
    ("sdump"    "pending" fsm-file-remove       ) 
    ("sdump"    "done"    fsm-no-op             )
    ("sdump"    "fail"    fsm-abort             )
    ("sdump"    "error"   fsm-abort             )
    ("sql"      "start"   fsm-no-op             ) 
    ("sql"      "created" fsm-no-op             ) ; fsm-file-digest
    ("sql"      "valid"   fsm-file-split-sql    ) ; OK
    ("sql"      "pending" fsm-file-remove       )
    ("sql"      "done"    fsm-no-op             )
    ("sql"      "fail"    fsm-abort             )
    ("sql"      "error"   fsm-abort             )
    ("schunk"   "start"   fsm-no-op             )
    ("schunk"   "created" fsm-no-op             ) ; fsm-file-digest
    ("schunk"   "valid"   fsm-file-load-insert  ) ; OK
    ("schunk"   "pending" fsm-file-remove       )
    ("schunk"   "done"    fsm-no-op             )
    ("schunk"   "fail"    fsm-abort             )
    ("schunk"   "error"   fsm-abort             )
    ("dchunk"   "start"   fsm-no-op             )
    ("dchunk"   "created" fsm-no-op             ) ; fsm-file-digest
    ("dchunk"   "valid"   fsm-file-load-insert  ) ; OK
    ("dchunk"   "pending" fsm-file-remove       ) ; 
    ("dchunk"   "done"    fsm-no-op             )
    ("dchunk"   "fail"    fsm-abort             )
    ("dchunk"   "error"   fsm-abort             )
    ("xincr"    "start"   fsm-file-download     )
    ("xincr"    "created" fsm-no-op             ) ; OK
    ("xincr"    "valid"   fsm-file-split-xdump  )
    ("xincr"    "pending" fsm-file-remove       )
    ("xincr"    "done"    fsm-no-op             )
    ("xincr"    "fail"    fsm-abort             )
    ("xincr"    "error"   fsm-abort             )
    ("idump"    "start"   fsm-file-download     )
    ("idump"    "created" fsm-no-op             ) ; fsm-file-digest
    ("idump"    "valid"   fsm-file-extract      ) ; OK
    ("idump"    "pending" fsm-file-remove       ) ;
    ("idump"    "done"    fsm-no-op             )
    ("idump"    "fail"    fsm-abort             )
    ("idump"    "error"   fsm-abort             )
    ("ichunk"   "start"   fsm-file-list-missing ) ; 
    ("ichunk"   "created" fsm-no-op             ) ; fsm-file-digest
    ("ichunk"   "valid"   fsm-file-wget         ) ; 
    ("ichunk"   "pending" fsm-file-remove       ) ; fsm-file-remove
    ("ichunk"   "done"    fsm-no-op             )
    ("ichunk"   "fail"    fsm-abort             )
    ("ichunk"   "error"   fsm-abort             )
    ("images"   "start"   fsm-images-directory  ) ; OK
    ("images"   "created" fsm-no-op             )
    ("images"   "valid"   fsm-no-op             )
    ("images"   "pending" fsm-no-op             )
    ("images"   "done"    fsm-no-op             )
    ("images"   "fail"    fsm-abort             )
    ("images"   "error"   fsm-abort             )
    ("error"    "start"   fsm-abort             )
    ("error"    "created" fsm-abort             )
    ("error"    "valid"   fsm-abort             )
    ("error"    "pending" fsm-abort             )
    ("error"    "done"    fsm-abort             )
    ("error"    "fail"    fsm-abort             )
    ("error"    "error"   fsm-abort             )))
(defconstant  *type-state-priority*
  ;;  type       state    concurrent image commons
  '(("database" "valid"   t          t     t    ) ; fsm-database-checksum
    ("database" "created" t          t     t    ) ; fsm-database-create
    ("database" "start"   t          t     t    ) ; fsm-database-grant
    ("table"    "pending" t          t     t    ) ; fsm-no-op
    ("table"    "start"   nil        t     t    ) ; fsm-table-block-size
    ("checksum" "pending" t          t     t    ) ; fsm-no-op
    ("checksum" "valid"   t          t     t    ) ; fsm-file-parse
    ("checksum" "created" t          t     t    ) ; fsm-file-digest
    ("checksum" "start"   nil        t     t    ) ; fsm-file-download
    ("xdump"    "pending" t          t     nil  ) ; fsm-file-remove
    ("xdump"    "valid"   t          t     nil  ) ; fsm-file-split-xdump
    ("xdump"    "created" t          t     nil  ) ; fsm-file-validate
    ("xdump"    "start"   nil        t     nil  ) ; fsm-file-download
    ("xincr"    "pending" t          t     nil  ) ; fsm-file-remove
    ("xincr"    "valid"   t          t     nil  ) ; fsm-file-split-xdump
    ("xincr"    "created" t          t     nil  ) ; fsm-no-op
    ("xincr"    "start"   nil        t     nil  ) ; fsm-file-download
    ("xml"      "pending" t          t     nil  ) ; fsm-file-remove
    ("xml"      "valid"   t          t     nil  ) ; fsm-file-split-xml
    ("xml"      "created" t          t     nil  ) ; fsm-file-digest
    ("xml"      "start"   t          t     nil  ) ; fsm-file-count
    ("table"    "created" t          t     t    ) ; fsm-table-drop-index
    ("sdump"    "pending" t          t     t    ) ; fsm-file-remove
    ("schunk"   "pending" t          t     t    ) ; fsm-file-remove
    ("schunk"   "valid"   nil        t     t    ) ; fsm-file-load-insert
    ("schunk"   "created" t          t     t    ) ; fsm-file-digest
    ("schunk"   "start"   t          t     t    ) ; fsm-no-op
    ("dchunk"   "pending" t          t     t    ) ; fsm-file-remove
    ("dchunk"   "valid"   nil        t     t    ) ; fsm-file-load-insert
    ("dchunk"   "created" t          t     t    ) ; fsm-file-digest
    ("dchunk"   "start"   t          t     t    ) ; fsm-no-op
    ("xchunk"   "pending" t          t     nil  ) ; fsm-file-remove
    ("xchunk"   "valid"   t          t     nil  ) ; fsm-file-process-xml
    ("xchunk"   "created" t          t     nil  ) ; fsm-file-digest
    ("xchunk"   "start"   t          t     nil  ) ; fsm-file-count
    ("sdump"    "valid"   t          t     t    ) ; fsm-file-split-sdump
    ("sdump"    "created" t          t     t    ) ; fsm-file-validate
    ("sdump"    "start"   nil        t     t    ) ; fsm-file-download
    ("sql"      "pending" t          t     t    ) ; fsm-file-remove
    ("sql"      "valid"   t          t     t    ) ; fsm-file-split-sql
    ("sql"      "created" t          t     t    ) ; fsm-file-digest
    ("sql"      "start"   t          t     t    ) ; fsm-no-op
    ("table"    "valid"   nil        t     t    ) ; fsm-table-add-index
    ("idump"    "pending" t          nil   nil  ) ; fsm-no-op
    ("idump"    "valid"   nil        nil   nil  ) ; fsm-file-extract
    ("idump"    "created" t          nil   nil  ) ; fsm-no-op
    ("idump"    "start"   nil        nil   nil  ) ; fsm-file-download
    ("images"   "start"   t          nil   t    ) ; fsm-images-directory
    ("ichunk"   "pending" t          nil   nil  ) ; fsm-file-remove
    ("ichunk"   "valid"   nil        nil   nil  ) ; fsm-file-wget
    ("ichunk"   "created" t          nil   nil  ) ; fsm-no-op
    ("ichunk"   "start"   nil        nil   nil  ) ; fsm-file-list-missing
    ("database" "pending" t          t     t    ) ; fsm-database-misc
    ("images"   "pending" t          nil   t    ) ; fsm-no-op
    ("images"   "valid"   t          nil   t    ) ; fsm-no-op
    ("images"   "created" t          nil   t    ) ; fsm-no-op
    )) 

(defun fsm-abort (file-name &key (put nil))
  "Aborting due to error condition"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |don't care          none
  ;; state-in  |see *type-state-function*
  ;; state-out |no change
  ;; Return: nil means fail, t means done.
  (let ((file-type  (sql-select-file-type  file-name))
	(file-state (sql-select-file-state file-name)))
    (put-message-start (_ "ERROR: in finite state machine"))
    (put-message (_ "this should never happen"))
    (put-message-value (_ "file-name")  file-name)
    (put-message-value (_ "file-type")  file-type)
    (put-message-value (_ "file-state") file-state)
    (put-message-value-fail-and-abort (_ "ERROR:") file-name))
  nil) ; always mark as `fail'

(defun set-mirror-wiki-list (&key (put nil))
  "Setting *mirror-wiki-list* (if not already done)"
  ;;
  ;; Design note:
  ;;
  ;; The first time this function is invoked (at the end of
  ;; installation), the `wpmirror' database has not yet been created.
  ;;
  (let ((wpmirror-file-table-p (assert-database-table-p "wpmirror" "file"
							:put put)))
    (when (and (null *mirror-wiki-list*)
	       (not (null wpmirror-file-table-p)))
      (setq *mirror-wiki-list*
	    (loop
	     ;; download *wikimedia-wiki-list* (if not already done)
	     with wikimedia-wiki-list       = (wikimedia-wiki-list :put put)
	     and  mirror-wiki-list          = (mirror-wiki-list :put put)
	     and  mirror-database-list      = (mirror-database-list :put put)
	     and  mirror-language-code-list = (mirror-language-code-list
					       :put put)
	     ;; filter for *mirror-project-list* and *mirror-language-code*
	     for wiki in wikimedia-wiki-list
	     when (or (member wiki mirror-wiki-list :test #'string=)
		      (member (wiki-to-database-name wiki)
			      mirror-database-list
			      :test #'string=)
		      (and
		       (member (wiki-to-project wiki)
			       *mirror-project-list*
			       :test #'string=)
		       (member (wiki-to-language-code wiki)
			       mirror-language-code-list
			       :test #'string=)))
	     collect wiki))))
  (put-message-value "*mirror-wiki-list*" *mirror-wiki-list* :put put)
  *mirror-wiki-list*)

(defun fsm-boot (&key (put nil))
  "Booting the finite state machine"
  ;; Prime the pump.  Insert database names into empty `wpmirror.file'
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |n/a                 database
  ;; state-in  |n/a                 n/a
  ;; state-out |n/a                 start
  ;; Return: nil means fail, t means done.
  (let* ((mirror-wiki-list (set-mirror-wiki-list :put put))
	 (results (loop
		     for wiki          in mirror-wiki-list
		     as  project        = (wiki-to-project       wiki :put put)
		     as  language-code  = (wiki-to-language-code wiki :put put)
		     as  database-name  = (wiki-to-database-name wiki :put put)
		     as  wiki-date-max  = (sql-select-wiki-most-recent-date
                                                                 wiki :put put)
		     as  wmf-xdump-date = (wiki-to-wikimedia-xdump-most-recent-date
				                                 wiki :put put)
		     as  wmf-xincr-date = (wiki-to-wikimedia-xincr-most-recent-date
				                                 wiki :put put)
		     as  should-build-p = (wiki-to-should-build-p
                                                                 wiki :put put)
		     as  xincr-list-new = (wiki-to-xincr-date-new-list
					                         wiki :put put)
		     as  should-increment-p = (not (null xincr-list-new))
		     as  build-state    = (wiki-to-build-state   wiki :put put)
		     when should-build-p
		       ;; clean house
		       do (delete-files-and-state-wiki wiki :put put)
		     end
		     when (and should-build-p (not should-increment-p))
		       ;; new database record
		       collect (sql-insert-file project wiki
						language-code wmf-xdump-date
						database-name "database"
						:put put)
		     end
		     when should-increment-p
		       ;; new database record
		       collect (sql-insert-file project wiki
						language-code wmf-xincr-date
						database-name "database"
						:put put)
		     end
		     when (and (or should-build-p should-increment-p) put)
		       do (put-message-value
			   (_ "record after insert")
			   (sql-select-file-all database-name :put put)
			   :put put)))
	 (clean-p (not (null results))))
    (put-flag-message :done (_ "done"))
    (not (member nil results))))

(defun wiki-to-should-build-p (wiki &key (put nil))
  "Determining if wiki should be built (usually by loading `xdump')"
  ;;
  ;; Design note:
  ;;
  ;; t   - if no `table' record found
  ;; nil - if `table' record found
  ;;
  ;; We use `table' rather than `xdump' because: 1) fast index
  ;; creation is the task performed when the `table' is built, and 2)
  ;; commonswiki is usually built using only its `image' table.
  ;;
  (let ((db-table-state (sql-select-wiki-table-state wiki :put put)))
    (null db-table-state)))

(defun wiki-to-xincr-date-new-list (wiki &key (put nil))
  "Determining dates of new increment files for given wiki"
  (let* ((wmf-xdump-date      (wiki-to-wikimedia-xdump-most-recent-date
				                                 wiki :put put))
	 (wmf-xincr-date-list (wiki-to-wikimedia-xincr-date-list wiki :put put))
	 (db-xdump-date       (sql-select-wiki-xdump-date        wiki :put put))
	 (db-xincr-date-max   (sql-select-wiki-xincr-date        wiki :put put))
	 (xincr-date-exclude  (cond ((null db-xdump-date)     wmf-xdump-date)
				    ((null db-xincr-date-max) db-xdump-date)
				    (t                        db-xincr-date-max)
				    )))
    (loop
     for date in wmf-xincr-date-list
     when (string> date xincr-date-exclude)
     collect date)))

(defun wiki-to-build-state (wiki &key (put nil))
  "Determining state of build using `xdump's"
  ;;
  ;; Design note:
  ;;
  ;;   `table' state                `xincr' state                build-state
  ;; -+----------------------------+----------------------------+--------------
  ;; 0 nil, `start'                 n/a                          `to-build'
  ;; 1 `create', `valid', `pending' n/a                          `building'
  ;; 2 `done', `fail', `error'      nil, `start'                 `to-increment'
  ;; 3 `done', `fail', `error'      `create', `valid', `pending' `incrementing'
  ;; 4 `done', `fail', `error'      `done', `fail', `error'      `done'
  ;;
  ;; We use `table' rather than `xdump' because: 1) fast index
  ;; creation is the task performed when the `table' is built, and 2)
  ;; commonswiki is usually built using only its `image' table.
  ;;
  (let* (;; wmf xdump
	 (wmf-xdump-date (wiki-to-wikimedia-xdump-most-recent-date wiki
							      :put put))
	 ;; wmf xincr
	 (wmf-xincr-date (wiki-to-wikimedia-xincr-most-recent-date wiki
							      :put put))
	 ;; database table
	 (db-table-date  (sql-select-wiki-table-date  wiki :put put))
	 (db-table-state (sql-select-wiki-table-state wiki :put put))
	 ;; database xdump
	 (db-xdump-date  (sql-select-wiki-xdump-date  wiki :put put))
	 (db-xdump-state (sql-select-wiki-xdump-state wiki :put put))
	 ;; database xincr
	 (db-xincr-date  (sql-select-wiki-xincr-date  wiki :put put))
	 (db-xincr-state (sql-select-wiki-xincr-state wiki :put put))
	 ;; build state
	 (build-state    (cond
			  ((null    db-table-state          ) "to-build")
			  ((string= db-table-state "start"  ) "building")
			  ((string= db-table-state "created") "building")
			  ((string= db-table-state "valid"  ) "building")
			  ((string= db-table-state "pending") "building")
			  (t
			   (cond
			    ((null    db-xincr-state          ) "to-increment")
			    ((string= db-xincr-state "start"  ) "incrementing")
			    ((string= db-xincr-state "created") "incrementing")
			    ((string= db-xincr-state "valid"  ) "incrementing")
			    ((string= db-xincr-state "pending") "incrementing")
			    (t                                  "done"))))))
    (put-message-value (_ "wmf-xdump-date db-table-date db-table-state")
		       (format nil "~a ~a ~a" wmf-xdump-date db-table-date
			       db-table-state)
		       :put put)
    (put-message-value (_ "wmf-xincr-date db-xincr-date db-xincr-state")
		       (format nil "~a ~a ~a" wmf-xincr-date db-xincr-date
			       db-xincr-state)
		       :put put)
    (put-flag-message-value :info wiki build-state)
    build-state))

(defun mirror-xchunk-page-count (wiki &key (put nil))
  "Setting `mirror-xchunk-page-count'"
  (let* ((language-code  (wiki-to-language-code wiki :put put))
	 (project        (wiki-to-project       wiki :put put))
	 (large-p        (member language-code
				 (append *wikimedia-large-language-code-list*
					 (list *mirror-commons*
					       *mirror-wikidata*))
				 :test #'string=)))
    (if (and large-p (string= "wikipedia" project))
	*mirror-xchunk-page-count-max*
      (value-within-bound *mirror-xchunk-page-count-min*
			  *mirror-xchunk-page-count*
			  *mirror-xchunk-page-count-max*))))

(defun fsm-database-checksum (database-name &key (put nil))
  "Inserting record for checksum file"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |database            checksum,ichunk,idump,images,table,xincr
  ;; state-in  |valid               n/a
  ;; state-out |pending             start
  ;; Return: nil means fail, t means done.
  ;;
  (let* ((project        (sql-select-file-project       database-name :put put))
	 (wiki           (sql-select-file-wiki          database-name :put put))
	 (date           (sql-select-file-date          database-name :put put))
	 (language-code  (sql-select-file-language-code database-name :put put))
	 (image-dir-path (wiki-to-image-directory       wiki          :put put))
	 (image-dir-p    (ext:probe-pathname            image-dir-path))
	 (wmf-xdump-date (wiki-to-wikimedia-xdump-most-recent-date
			                                wiki          :put put))
	 (file-name      (wiki-to-checksums-file-name   wiki wmf-xdump-date
							              :put put))
	 (should-build-p (wiki-to-should-build-p        wiki          :put put))
	 (xincr-new-list (wiki-to-xincr-date-new-list   wiki          :put put))
	 (build-state    (wiki-to-build-state           wiki          :put put))
	 (result         nil))
    ;; make newline so [info] build-state is not overwritten
    (put-flag-message :done (_ "wait"))
    ;; create `table' records
    (when (and should-build-p
	       (eq *mirror-process-xml* :xml2sql)
	       *mirror-xdump-download-p*
	       *mirror-innodb-fast-index-creation*)
      (loop
       for table-key-block-size in *mirror-innodb-table-key-block-size-list*
       as  table-name = (first table-key-block-size)
       do (sql-insert-file project wiki
			   language-code wmf-xdump-date
			   (format nil "~a.~a" database-name table-name)
			   "table"
			   :put put)))
    ;; create `checksum' record
    (when (and should-build-p
	       *mirror-xdump-download-p*)
      (setq result (sql-insert-file project wiki
				    language-code wmf-xdump-date
				    file-name "checksum"
				    :put put))
      (when (eq put t)
	(put-message-value (_ "record after insert")
			   (sql-select-file database-name :put put) :put put)))
    ;; create `idump', `ichunk', and `images' records
    (when (and *wikimedia-site-image*
	       *mirror-image-download-p*
	       (or
		;; 1) usual case   - `xxwiki'
		(and
		 (not (string= wiki *mirror-commonswiki*)))
		;; 2) unusual case - `commonswiki' (need 20T HDD)
		(and
		 (string= wiki *mirror-commonswiki*)
		 (mirror-commonswiki-p :put put))
		))
      ;; create `idump' records
      (when (and *wikimedia-site-idump*
		 (null image-dir-p)) ; if no ../images/<project>/<lang-code>/
	(loop
	 for idump-name in (wiki-to-idump-list wiki :put put)
	 as  idump-date = (second (regexp:regexp-split "-" idump-name))
	 do (sql-insert-file project wiki
			     language-code idump-date
			     idump-name "idump"
			     :put put)))
      ;; create `ichunk' records
      ;; simplewiki-yyyymmdd-local-media-0-00
      ;; simplewiki-yyyymmdd-local-media-0-01 ...
      (loop
       with hex = (the simple-string "0123456789abcdef")
       for c1 of-type standard-char across hex
       as  d1 =  (string c1)
       do
       (sleep 0.5)
       (loop
	for c2 of-type standard-char across hex
	as  d2 = (format nil "~a~a" c1 c2)
	as  ichunk-name-local = (format nil "~a-~a-local-media-~a-~a"
					database-name date d1 d2)
	do (sql-insert-file project wiki
			    language-code date
			    ichunk-name-local "ichunk"
			    :put nil)))
      (unless (string= wiki *mirror-commonswiki*)
	;; simplewiki-yyyymmdd-remote-media-0-00
	;; simplewiki-yyyymmdd-remote-media-0-01 ...
	(loop
	 with hex = (the simple-string "0123456789abcdef")
	 for c1 of-type standard-char across hex
	 as  d1 =  (string c1)
	 do
	 (sleep 0.5)
	 (loop
	  for c2 of-type standard-char across hex
	  as  d2 = (format nil "~a~a" c1 c2)
	  as ichunk-name-remote = (format nil "~a-~a-remote-media-~a-~a"
					  database-name date d1 d2)
	  do (sql-insert-file project wiki
			      language-code date
			      ichunk-name-remote "ichunk"
			      :put nil))))
      ;; create `images' records
      (sql-insert-file project wiki
		       language-code date
		       (format nil "~a-images" database-name)
		       "images" :put nil)
      ;; create `xincr' records
      (loop
       for xincr-date in xincr-new-list
       as  xincr-pages-name = (format nil "~a-~a-pages-meta-hist-incr.xml.bz2"
				      wiki xincr-date)
       as  xincr-stubs-name = (format nil "~a-~a-stubs-meta-hist-incr.xml.gz"
				      wiki xincr-date)
       do (sql-insert-file project wiki
			   language-code xincr-date
			   xincr-pages-name "xincr"
			   :put put)
          (sql-insert-file project wiki
			   language-code xincr-date
			   xincr-stubs-name "xincr"
			   :put put))))
  t)

(defun fsm-database-create (database-name &key (put nil))
  "Asserting or creating, and updating database using template file `database_farm.sql'"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |database            n/a
  ;; state-in  |created             n/a
  ;; state-out |valid               n/a
  ;; Return: nil means fail, t means done.
  (let* ((path-name (merge-pathnames
		     (parse-namestring *whereis-directory-mediawiki-maintenance*)
		     (parse-namestring *whereis-file-mediawiki-farm-database*)))
	 (wiki           (sql-select-file-wiki database-name :put put)))
    (and
     (assert-database-or-load database-name path-name :put put)
     (update-database-for-wiki-p    wiki :put put))))

(defun fsm-database-grant (database-name &key (put nil))
  "Granting privileges on database to users `wikiadmin' and `wikiuser'"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |database            n/a
  ;; state-in  |start               n/a
  ;; state-out |created             n/a
  ;; Return: nil means fail, t means done.
  (sql-grant-all-on-database-to-wikiadmin database-name :put put)
  (sql-grant-siud-on-database-to-wikiuser database-name :put put)
  t)

(defun fsm-database-misc (database-name &key (put nil))
  "Post-processing various tables"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |database            n/a
  ;; state-in  |pending             n/a
  ;; state-out |done                n/a
  ;; Return: nil means fail, t means done.
  (let ((wiki           (sql-select-file-wiki database-name :put put)))
;;    (put-flag-message :info (_ "populate interwiki table"))
;;    (sql-insert-interwiki-link-list  wiki
;;				     ;;(mirror-language-code-list :put put)
;;				     (wikimedia-language-code-list :put put)
;;				     :put put)
    ;; delete orphans and superseded revisions
    (when *mirror-delete-superseded-revisions*
      (put-flag-message :info (_ "delete orphan rows from revision table"))
      (sql-delete-orphan-from-revision     wiki :put put)
      (put-flag-message :info (_ "delete orphan rows from page table"))
      (sql-delete-orphan-from-page         wiki :put put)
      (put-flag-message :info (_ "delete superseded rows from revision table"))
      (sql-delete-superseded-from-revision wiki :put put)
      (put-flag-message :info (_ "delete orphan rows from text table"))
      (sql-delete-orphan-from-text         wiki :put put))
    ;; rebuild search indices
    (put-flag-message :info (_ "rebuild titlekey table"))
    (rebuild-titlekey-for-wiki-p         wiki :put put)
;;    (put-flag-message :info (_ "create and update search indices"))
;;    (create-and-update-search-indices-for-wiki-p wiki :put put)
;;    (populate-search-indices-for-wiki-p          wiki :put put)
    (put-flag-message :info (_ "done"))
    t))

(defun fsm-file-count (file-name &key (put nil))
  "Counting pages `<page>' and images `[[File' and `[[Image:'  in `.xml' files"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |xml, xchunk, ichunk none
  ;; state-in  |start
  ;; state-out |created
  ;; Return: nil means fail, t means done.
  (sql-update-file-size file-name :put put)
  (let ((file-type   (sql-select-file-type file-name :put put))
	(page-count  0)
	(image-count 0))
    (when (or (string= file-type "xml") (string= file-type "xchunk"))
      (setq page-count (shell-count-page file-name :put put))
      (sql-update-file file-name :pages page-count :put put))
    (setq image-count (shell-count-image file-name :put put))
    (sql-update-file file-name :images image-count :put put)))

(defun fsm-file-decompress (file-name &key (put nil))
  "Decompressing xdump file to yield XML file"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |xdump,sdump         xml,sql
  ;; state-in  |valid               n/a
  ;; state-out |pending             start
  ;; Return: nil means fail, t means done.
  (let* ((project        (sql-select-file-project       file-name :put put))
	 (wiki           (sql-select-file-wiki          file-name :put put))
	 (language-code  (sql-select-file-language-code file-name :put put))
	 (file-date      (sql-select-file-date          file-name :put put))
	 (file-type      (sql-select-file-type          file-name :put put))
	 ;; next-name
	 ;;   xxwiki-yyyymmdd-tablename.sql
	 ;;   xxwiki-yyyymmdd-tablename.xml
	 (next-name      (join (butlast (regexp:regexp-split
					 (regexp:regexp-quote ".") file-name))
			       "."))
	 (file-compress  (first (last (regexp:regexp-split
				       (regexp:regexp-quote ".") file-name))))
	 (next-type      (cond ((string= file-type "xdump") "xml")
			       ((string= file-type "sdump") "sql"))))
    (put-message-start (_ "decompressing") :put put)
    (put-message-value (_ "file name decompressed") next-name :put put)
    ;; 1) make record for new file
    (sql-insert-file project wiki
		     language-code file-date
		     next-name next-type
		     :put put)
    ;; 2) decompress xdump,sdump
    (cond ((string= file-compress "bz2")(shell-bunzip2     file-name :put put))
	  ((string= file-compress "gz") (shell-gunzip-keep file-name :put put)))
    ;; 3) update record in `wpmirror.file' database table
    (when (ext:probe-pathname next-name)
      (sql-update-file-size next-name :put put))
    (put-message-done (_ "decompressing") :put put)
    (ext:probe-pathname next-name)))
				       
(defun fsm-file-digest (file-name &key (put nil))
  "Computing md5sum digest"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |any except xdump    n/a
  ;; state-in  |created             
  ;; state-out |valid               
  ;; Return: nil means fail, t means done.
  (debug-message-value (_ "file-name") file-name)
  (let ((result (shell-md5sum file-name :put put)))
    (if (null result)
	(put-message-value-fail-and-abort (_ "md5sum returned") result)
      (progn
	(debug-message-value (_ "md5sum") result)
	(sql-update-file-md5sum file-name result :put put)))))

(defun fsm-file-download (file-name &key (put nil))
  "Downloading checksum or xdump file"
  ;; Files and states:
  ;;           |input file               generated file(s)
  ;; ----------+------------------------+------------------------
  ;; file-type |checksum,[xsi]dump,xincr checksum,[xsi]dump,xincr
  ;; state-in  |start
  ;; state-out |created
  ;; Return: nil means fail, t means done.
  ;;
  ;; Names: 
  ;; site     like `rsync://ftpmirror.your.org/wikimedia-dumps/'
  ;; checksum like `xxwiki/yyyymmdd/xxwiki-yyyymmdd-md5sums.txt'
  ;; xdump    like `xxwiki/yyyymmdd/xxwiki-yyyymmdd-pages-articles.xml.bz2'
  ;; sdump    like `xxwiki/yyyymmdd/xxwiki-yyyymmdd-image.sql.gz'
  ;; xincr    like `other/incr/xxwiki/yyyymmdd/xxwiki-yyyymmdd-pages-meta-hist-incr.xml.bz2'
  ;;
  ;; site     like `rsync://ftpmirror.your.org/wikimedia-imagedumps/tarballs/'
  ;; idump    like `fulls/yyyymmdd/xxwiki-yyyymmdd-local-media-1.tar'
  ;;               `fulls/yyyymmdd/xxwiki-yyyymmdd-remote-media-1.tar'
  ;;
  ;; Design note:
  ;;
  ;; Languages such as `zh-classical' (i.e. `xx' contains a dash `-')
  ;; must be carefully handled.  MySQL does not readily accept
  ;; database names containing a dash:
  ;;
  ;; fail:  CREATE DATABASE zh-classicalwiki;
  ;; OK  :  CREATE DATABASE `zh-classicalwiki`;
  ;; OK  :  CREATE DATABASE zh_classicalwiki;
  ;; 
  ;; Wikimedia Foundation usage is:
  ;; 
  ;; underscore : directory     : http://dumps.wikimedia.org/zh_classical/...
  ;;            : checksum file : zh_classicalwiki-yyyymmdd-md5sums.txt
  ;;            : xdump file    : zh_classical-yyyymmdd-pages-articles.xml.bz2
  ;; dash       : URL           : http://zh-classical.wikipedia.org/
  ;;
  ;; Hence: http://dumps.wikimedia.org/zh_classicalwiki/latest/zh_classicalwiki
  ;;
  ;; Wp-mirror attempts to follow Wikimedia Foundation usage:
  ;; language-codes use dash, while files and databases use underscore.
  ;; See functions `wiki-file-name' and `str_replace'.
  ;;
  (debug-message-value (_ "file-name") file-name)
  (let* ((partition-images-free (system-partition-free-images :put put))
	 (file-type             (file-name-to-type      file-name :put put))
	 (path-name             (file-name-to-path-name file-name :put put))
	 (url                   (file-name-to-url       file-name :put put))
	 (file-size             0)
	 (space-needed          0))
    (put-message url :put put)
    (when path-name
      (setq file-size (download-file-size-remote url :put put))
      (sql-update-file file-name :size file-size :put put) ; remote file size
      (setq space-needed
	    (cond ((member file-type '("idump") :test #'string=)
		   (* 2 file-size))
		  ((member file-type '("checksum" "sdump") :test #'string=)
		   (* 3 file-size))
		  ((member file-type '("xdump" "xincr") :test #'string=)
		   (* 5 file-size))
		  (t file-size)))
      ;; 1) download file
      (if (> partition-images-free space-needed)
	  (when (download-file url path-name :put put)      ; download file
	    (put-message path-name :put put))
	(progn
	  (put-message-fail-2 (_ "insufficient disk space") :put t))))
    ;; 2) update record in `wpmirror.file' database table
    (when (file-exists-p path-name :put put)
      (sql-update-file-size file-name :put put))))          ; local file size

(defun fsm-file-extract (idump-name &key (put nil))
  "Extracting `idump' into images directory"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |idump               none
  ;; state-in  |valid               n/a
  ;; state-out |pending             
  ;; Return: nil means fail, t means done.
  ;;
  ;; Design note:
  ;;
  ;; This function:
  ;;   o changes CWD to the working directory (if not already there),
  ;;   o move the `idump' to the images directory, 
  ;;   o changes CWD to the images directory,
  ;;   o probes that the `idump' is there,
  ;;   o extracts the `idump' (which is a tarball),
  ;;   o removes the `idump', and finally,
  ;;   o changes CWD back to the working directory,
  ;; where CWD means `current working directory'.
  ;;
  (let* ((path-name *whereis-directory-mediawiki-images*)
	 (r         nil)) ; result
    (debug-message idump-name)
    (ext:cd *whereis-directory-wpmirror-working*)
    (debug-message-value (_ "moving") idump-name)
    (setq r (null (shell-move-file idump-name path-name :put put)))
    (when r
      (debug-message-value (_ "changing to images directory")
			   path-name)
      (ext:cd path-name)
      (debug-message-value (_ "current working directory is now") 
			   (ext:cd))
      (debug-message-value (_ "probing") (ext:probe-pathname idump-name))
      (setq r (ext:probe-pathname idump-name))
      (when r
	(debug-message-value (_ "extracting")
			     (ext:probe-pathname idump-name))
	(setq r (null (shell-extract-tarball idump-name :put put)))
	(when r
	  (debug-message-value (_ "removing") 
			       (ext:probe-pathname idump-name))
	  (shell-remove-file idump-name :put put))))
    (debug-message-value (_ "changing to working directory")
			 *whereis-directory-wpmirror-working*)
    (ext:cd *whereis-directory-wpmirror-working*)
    (debug-message-value (_ "current working directory is now") (ext:cd))
    (put-flag-message :info (_ "done"))
    r))

(defun fsm-file-list-missing (ichunk-name &key (put nil))
  "Listing URLs of missing image files referenced by given wiki"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |`ichunk'            ichunk file
  ;; state-in  |start               n/a
  ;; state-out |created             
  ;; Return: nil means fail, t means done.
  ;;
  ;; Design note:
  ;;
  ;; 1) Introduction
  ;; 
  ;; 1a) We can easily identify all the image file names referenced by
  ;; the given wiki.  Here are the `remote-media' (meaning commons)
  ;; image file names with `md5sum's beginning with `00'.
  ;;
  ;; mysql> SELECT DISTINCT MD5(img_name) AS md5sum,img_name
  ;;     -> FROM commonswiki.image,simplewiki.imagelinks
  ;;     -> WHERE il_to=img_name
  ;;     -> AND MD5(img_name) LIKE '00%' 
  ;;     -> ORDER BY md5sum ASC;
  ;; +----------------------------------+--------------------------------+
  ;; | md5sum                           | img_name                       |
  ;; +----------------------------------+--------------------------------+
  ;; | 00000e474bf09f43f951960ab7077b15 | Paulasage.JPG                  |
  ;; | 0000ee8522e7eb9d0dfe503a20cfd76c | Wikisanta-no_motto.png         |
  ;; | 000121047850997692bd7c6a41349e54 | Heliodoxa_leadbeateri_2.jpg    |
  ;; | ...                              | ...                            |
  ;; | 00ffbb6123766d97fce4423e44a37386 | BanburyStation.jpg             |
  ;; +----------------------------------+--------------------------------+
  ;;
  ;; 1b) From the `md5sum' and `img_name's, we can create paths where
  ;; the images should be stored:
  ;;
  ;; /var/lib/wp-mirror-mediawiki/images/wikipedia/commons/0/00/Paulasage.JPG
  ;; /var/lib/wp-mirror-mediawiki/images/wikipedia/commons/0/00/Wikisanta-no_motto.png
  ;;
  ;; We filter paths that already exist to identify those which are missing.
  ;;
  ;; 1c) From the `md5sum' and `img_name's, we can create URLs:
  ;;
  ;; http://upload.wikipedia.org/wikipedia/commons/0/00/Paulasage.JPG
  ;; http://upload.wikipedia.org/wikipedia/commons/0/00/Wikisanta-no_motto.png
  ;; ...
  ;;
  ;; The URL list is written to a file such as:
  ;;   `simplewiki-yyyymmdd-local-media-0-00' or
  ;;   `simplewiki-yyyymmdd-remote-media-0-00' 
  ;;
  ;; 2) SQL
  ;;
  ;; The `local-media' file-names list is found with:
  ;;
  ;; mysql> SELECT img_name
  ;;     -> FROM simplewiki.image,
  ;;     -> (SELECT DISTINCT il_to FROM simplewiki.imagelinks) AS tmp
  ;;     -> WHERE il_to=img_name
  ;;     -> AND MD5(il_to) LIKE '00%' 
  ;;     -> ORDER BY img_name ASC;
  ;;
  ;; The `remote-media' file-names list is found with:
  ;;
  ;; mysql> SELECT img_name
  ;;     -> FROM commonswiki.image,
  ;;     -> (SELECT DISTINCT il_to FROM simplewiki.imagelinks) AS tmp
  ;;     -> WHERE il_to=img_name
  ;;     -> AND MD5(il_to) LIKE '00%' 
  ;;     -> ORDER BY img_name ASC;
  ;;
  (put-message-value (_ "ichunk file") ichunk-name :put put)
  (let* ((project          (sql-select-file-project       ichunk-name :put put))
	 (wiki             (sql-select-file-wiki          ichunk-name :put put))
	 (language-code    (sql-select-file-language-code ichunk-name :put put))
	 (local-p          (regexp:match "local" ichunk-name))
	 ;; simplewiki-yyyymmdd-local-media-0-00
	 (d1               (fifth (regexp:regexp-split "-" ichunk-name)))
	 (d2               (sixth (regexp:regexp-split "-" ichunk-name)))
	 ;; local  = /var/lib/wp-mirror-mediawiki/images/wikipedia/simple/0/00/
	 (path-stub-local  (format nil "~a~a/~a/~a/~a/" 
				   *whereis-directory-mediawiki-images*
				   project language-code d1 d2))
	 ;; remote = /var/lib/wp-mirror-mediawiki/images/wikipedia/commons/0/00/
         (path-stub-remote (format nil "~a~a/~a/~a/~a/" 
				   *whereis-directory-mediawiki-images*
				   "wikipedia" *mirror-commons* d1 d2))
	 ;; local  = http://upload.wikimedia.org/wikipedia/simple/0/00/
	 (url-stub-local   (format nil "~a~a/~a/~a/~a/" 
				   *wikimedia-site-image*
				   project language-code d1 d2))
	 ;; remote = http://upload.wikimedia.org/wikipedia/commons/0/00/
	 (url-stub-remote  (format nil "~a~a/~a/~a/~a/" 
				   *wikimedia-site-image*
				   "wikipedia" *mirror-commons* d1 d2))
	 (image-list-all  nil)
	 (image-list-miss nil))
    (put-message-start (_ "listing URLs for missing image files") :put put)
    (with-open-file (s ichunk-name
		       :direction :output
		       :if-exists :supersede)
      ;; 1) SELECT image file names (list of strings)
      (if local-p
	  (setq image-list-all (sql-select-image-list-local wiki d2 :put put))
	(setq image-list-all (sql-select-image-list-remote wiki d2 :put put)))
      (put-message image-list-all :put put)
      (setq image-list-miss nil)
      ;; 2) keep image file names that are missing
      (loop 
       for image-file-name in image-list-all
       as  path = (format nil "~a~a" 
			  (if local-p
			      path-stub-local
			    path-stub-remote)
			  image-file-name)
       do (put-message path :put put)
          (unless (or (find #\? image-file-name)     ; skip wildcards
		      (find #\* image-file-name))
	    (unless (ext:probe-pathname path)        ; skip if exists
	      (push image-file-name image-list-miss))))
      (put-message image-list-miss :put put)
      (put-message "done" :put put)
      ;; 3) write `ichunk' to disk
      (loop
       for image-file-name in image-list-miss
       do (format s "~a~a~%" 
		  (if local-p 
		      url-stub-local
		    url-stub-remote)
		  image-file-name)))
    ;; 4) update record in `wpmirror.file' database table
    (when (ext:probe-pathname ichunk-name)
      (sql-update-file-size ichunk-name :put put))
    ;; 5) return
    (put-message-done (_ "listing URLs for missing image files") :put put)
    (ext:probe-pathname ichunk-name)))

(defun fsm-file-load-insert (file-name &key (put nil))
  "Loading `dchunk' or `schunk' into wiki database"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |dchunk,schunk       none
  ;; state-in  |valid               n/a
  ;; state-out |pending
  ;; Return: nil means fail, t means done.
  ;;
  ;; Design note:
  ;;
  ;; To prevent a flood of data from overwhelming `mysqld', we guard
  ;; each transaction with wait-loops.
  ;;
  ;; For `schunk' we look for  "REPLACE" statements
  ;; For `dchunk' we look for  "INFILE" statements
  ;;
  (put-message-value (_ "schunk file") file-name :put put)
  (let* ((file-type     (file-name-to-type          file-name :put put))
	 (database-name (file-name-to-database-name file-name :put put))
	 (result        nil)
	 (xchunk-name   nil))
    (cond ((string= file-type "schunk")
	   ;; wait until no other REPLACE transaction
	   (sleep-until-zero
	    #'sql-select-schema-count-innodb-trx "REPLACE" :put put)
	   ;; submit REPLACE INTO transaction
	   (setq result (shell-mysql-load-dump-file
			 database-name file-name :put put))
	   (unless (eql result 'eof)
	     (put-message-fail result))
	   ;; wait until transaction completes
	   (sleep-until-zero
	    #'sql-select-schema-count-innodb-trx "REPLACE" :put put))
	  ((string= file-type "dchunk")
	   ;; wait until no other LOAD DATA transaction
	   (sleep-until-zero
	    #'sql-select-schema-count-innodb-trx "INFILE" :put put)
	   ;; submit LOAD DATA INFILE transaction
	   (setq result (sql-load-data-infile file-name :put put))
	   (unless (eql result 'eof)
	     (put-message-fail result))
	   ;; wait until transaction completes
	   (sleep-until-zero
	    #'sql-select-schema-count-innodb-trx "INFILE" :put put)))
    (setq result (eql result 'eof))
    ;; when `d/schunk' fails, then original `xchunk' should also.
    (unless result
      (setq xchunk-name (file-name-to-xchunk-name file-name :put put))
      (when xchunk-name
	(put-message-fail-2 xchunk-name)
	(sql-update-file-state xchunk-name "fail" :put put)))
    result))

(defun fsm-file-parse (file-name &key (put nil))
  "Parsing checksums file to identify xdump file"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |checksum            xdump,sdump
  ;; state-in  |valid               n/a
  ;; state-out |pending
  ;; Return: nil means fail, t means done.
  ;;
  (put-message-value (_ "checksums file") file-name :put put)
  (put-message-start (_ "looking for pattern match") :put put)
  (let* ((project        (sql-select-file-project       file-name :put put))
	 (wiki           (sql-select-file-wiki          file-name :put put))
	 (language-code  (sql-select-file-language-code file-name :put put))
	 (result         t))
    (loop
     ;; wikimedia-path-dump-template
     ;;   `xxwiki/yyyymmdd/xxwiki-yyyymmdd-tablename.sql.gz'
     ;;   `xxwiki/yyyymmdd/xxwiki-yyyymmdd-xmldumptype.xml.bz2'
     with wikimedia-path-dump-template-list =
          (wikimedia-path-dump-template-list wiki :put put)
     for wikimedia-path-dump-template in wikimedia-path-dump-template-list
     ;; dump-template `xxwiki-yyyymmdd-tablename.sql.gz'
     as  dump-template = (first (last (regexp:regexp-split 
				       "/" wikimedia-path-dump-template)))
     ;; dump-pattern `tablename.sql.gz' or `xmldumptype.xml.bz2'
     as  dump-pattern  = (join (cddr (regexp:regexp-split "-" dump-template))
			       "-")
     ;; table-name `tablename' or `xmldumptype'
     as  table-name    = (first (regexp:regexp-split (regexp:regexp-quote ".")
						     dump-pattern))
     ;; dump-format `sql' or `xml'
     as  dump-format = (second (regexp:regexp-split (regexp:regexp-quote ".")
						    dump-pattern))
     as  dump-type     = (cond ((string= dump-format "sql") "sdump")
			       ((string= dump-format "xml") "xdump")
			       (t (put-message-value-fail-and-abort
				   (_ "unknown dump format")
				   dump-format)))
     ;; line:  `md5sum-of-dump'  `xxwiki-yyyymmdd-tablename.sql.gz'
     as  line          = (grep-first file-name dump-pattern :put put)
     if (null line) 
       do
          (put-flag-message-value :info (_ "dump file not ready") dump-pattern)
	  (setq result nil)
     else 
       do
        (let* ((dump-checksum   (first  (regexp:regexp-split " " line)))
	       (dump-name       (first  (last (regexp:regexp-split " " line))))
	       (dump-date       (second (regexp:regexp-split "-" dump-name))))
	  (put-message-value (_ "dump file name")     dump-name     :put put)
	  (put-message-value (_ "dump file checksum") dump-checksum :put put)
	  (put-message-done  (_ "looking for pattern match") :put put)
	  (when (or 
		 ;; 1a) usual case   - `commonswiki.image' table
		 (and (string= wiki *mirror-commonswiki*)
		      *mirror-image-download-p*
		      (string= table-name "image"))
		 ;; 1b) unusual case - `commonswiki.*' tables
		 (and (string= wiki *mirror-commonswiki*)
		      (mirror-commonswiki-p :put put))
		 ;; 2a) unusual case - `wikidatawiki.*' tables
		 (and (string= wiki *mirror-wikidatawiki*)
;		      (mirror-wikidatawiki-p :put put)
		      *mirror-image-download-p*)
		 ;; 2b) unusual case - `wikidatawiki.*' except `image' table
		 (and (string= wiki *mirror-wikidatawiki*)
;		      (mirror-wikidatawiki-p :put put)
		      (not *mirror-image-download-p*)
		      (not (string= table-name "image")))
		 ;; 3a) usual case   - `xxwiki.*' tables
		 (and (not (string= wiki *mirror-commonswiki*))
		      (not (string= wiki *mirror-wikidatawiki*))
		      *mirror-image-download-p*)
		 ;; 3b) unusual case - `xxwiki.*' except `image' table
		 (and (not (string= wiki *mirror-commonswiki*))
		      (not (string= wiki *mirror-wikidatawiki*))
		      (not *mirror-image-download-p*)
		      (not (string= table-name "image"))))
	    (put-message-start (_ "sql-insert-file dump") :put put)
	    (sql-insert-file project wiki
			     language-code dump-date
			     dump-name dump-type
			     :md5sum dump-checksum
			     :put put)
	    (put-message-done (_ "sql-insert-file dump") :put put)))
	end) ; loop
	(when (null result)
	  (put-message "done" :put t))
    t))

(defun fsm-file-remove (file-name &key (put nil))
  "Removing working files that are no longer needed"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |any                 none
  ;; state-in  |pending
  ;; state-out |done
  ;; Return: nil means fail, t means done.
  ;;
  ;; Design note:
  ;;
  ;; `xchunk's are a special case where we remove two files:
  ;; 1) either `xchunk's from split `xincr' with names like
  ;;   simplewiki-yyyymmdd-pages-meta-hist-incr-p000000000-c000001000.xml.gz
  ;;   simplewiki-yyyymmdd-stubs-meta-hist-incr-p000000000-c000001000.xml.gz
  ;; 2) or `xchunk's from split `xdump' with names like
  ;;   simplewiki-yyyymmdd-pages-articles-p000000000-c000001000.xml.bz2
  ;;   simplewiki-yyyymmdd-stub-articles-p000000000-c000001000.xml.gz
  ;;
  (let* ((file-type   (file-name-to-type file-name :put put))
	 (file-incr-p (not (null (regexp:match "incr" file-name))))
	 (file-stub   nil))
    ;; special case, remove `stub' or `stubs' file
    (when (string= file-type "xchunk")
      (setq file-stub
	    (concatenate 'string
              (first (regexp:regexp-split "bz2"
                (join (regexp:regexp-split "pages" file-name)
                  (if file-incr-p
		      "stubs"                  ; <- from `xincr'
		    "stub"))))                 ; <- from `xdump'
		  "gz"))
      (shell-remove-file file-stub :put put))
    ;; remove file
    (not (shell-remove-file file-name :put put))))

(defun fsm-file-split-sdump (file-name &key (put nil))
  "Splitting decompressed `sdump' file into `schunk's or `dchunk's"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |sdump               schunk or dchunk
  ;; state-in  |valid               n/a
  ;; state-out |pending             start
  ;; Return: nil means fail, t means done.
  ;;
  ;; Design note:
  ;;
  ;; 1) Sdumps like `simplewiki-yyyymmdd-image.sql.gz' consist of the
  ;; following sections:
  ;;
  ;; 1a) DBMS specific commands to save variable values, and reset them:
  ;;
  ;; /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */;
  ;; /*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */;
  ;; /*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */;
  ;; /*!40101 SET NAMES utf8 */;
  ;; /*!40103 SET @OLD_TIME_ZONE=@@TIME_ZONE */;
  ;; /*!40103 SET TIME_ZONE='+00:00' */;
  ;; /*!40014 SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0 */;
  ;; /*!40014 SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0 */;
  ;; /*!40101 SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO' */;
  ;; /*!40111 SET @OLD_SQL_NOTES=@@SQL_NOTES, SQL_NOTES=0 */;
  ;;
  ;; 1b) DROP TABLE and CREATE TABLE
  ;;
  ;; DROP TABLE IF EXISTS `image`;
  ;; /*!40101 SET @saved_cs_client     = @@character_set_client */;
  ;; /*!40101 SET character_set_client = utf8 */;
  ;; CREATE TABLE `image` (
  ;;  ...
  ;;
  ;; 1c) Data dump
  ;;
  ;; /*!40000 ALTER TABLE `image` DISABLE KEYS */;         <-- used by MyISAM
  ;; INSERT INTO `image` VALUES (...                       <-- we want these
  ;; INSERT INTO `image` VALUES (...                       <-- 
  ;; ...
  ;; /*!40000 ALTER TABLE `image` ENABLE KEYS */;          <-- used by MyISAM
  ;;
  ;; 1d) Restore DBMS variables
  ;;
  ;; /*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;
  ;; /*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
  ;; /*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */;
  ;; /*!40014 SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS */;
  ;; /*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */;
  ;; /*!40101 SET CHARACTER_SET_RESULTS=@OLD_CHARACTER_SET_RESULTS */;
  ;; /*!40101 SET COLLATION_CONNECTION=@OLD_COLLATION_CONNECTION */;
  ;; /*!40111 SET SQL_NOTES=@OLD_SQL_NOTES */;
  ;;
  ;; 2) Files like `simplewiki-yyyymmdd-page-p000001000-c000001000.sql',
  ;; `simplewiki-yyyymmdd-revision-p000001000-c000001000.sql', and
  ;; `simplewiki-yyyymmdd-text-p000001000-c000001000.sql' are of type
  ;; `schunk' and not `sql', and therefore should not appear here.
  ;;
  ;; Such files are generated by `fsm-file-convert-xml2sql' from the `xchunk's
  ;; `simplewiki-yyyymmdd-stub-articles-p000001000-c000001000.xml', and
  ;; `simplewiki-yyyymmdd-pages-articles-p000001000-c000001000.xml'.
  ;;
  (case *mirror-split-sql*
	(:schunk   (fsm-file-split-sdump-to-schunk file-name :put put))
	(:dchunk   (fsm-file-split-sdump-to-dat    file-name :put put))
	(otherwise (put-message-value-fail-and-abort
		    (_ "Error: *mirror-split-sql*")
		    *mirror-split-sql*))))

(defun fsm-file-split-sdump-to-schunk (file-name &key (put nil))
  "Splitting `sdump' file into `schunk's"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |sdump               schunk
  ;; state-in  |valid               n/a
  ;; state-out |pending             start
  ;; Return: nil means fail, t means done.
  ;;
  ;; Design note:
  ;;
  ;; The shell pipeline:
  ;;
  ;; (shell) time zgrep 'INSERT INTO' commonswiki-yyyymmdd-image.sql.gz |
  ;;              replace 'INSERT INTO' 'REPLACE INTO' |
  ;;              split --lines=10 --numeric-suffixes --suffix-length=9
  ;; --filter='(echo "START TRANSACTION;";cat -;echo"COMMIT;") | gzip > $FILE'
  ;;                    - commonswiki-yyyymmdd-image.sql.gz
  ;;
  ;; runs quickly (3880s). This constitutes a significant performance
  ;; gain (54% less time) than `fsm-file-decompress' (2200s) +
  ;; `fsm-file-split-sql' (6200s) = (8400s). This uses significantly
  ;; less disk space (23G) in the working directory; which is also a
  ;; significant gain (63% less space) than `fsm-file-split-sql'
  ;; (62G).
  ;;
  (let ((project       (sql-select-file-project       file-name :put put))
	(wiki          (sql-select-file-wiki          file-name :put put))
	(language-code (sql-select-file-language-code file-name :put put))
	(file-date     (sql-select-file-date          file-name :put put)))
    ;; do `zgrep-replace-split' into files named like:
    ;;   `commonswiki-yyyymmdd-image.sql.gz000000000',
    ;;   `commonswiki-yyyymmdd-image.sql.gz000000001', ...
    (shell-split-sdump-to-schunk file-name :put put)
    ;; rename `schunks' to be like:
    ;;   `commonswiki-yyyymmdd-image-p000000000-c000000010.sql.gz',
    ;;   `commonswiki-yyyymmdd-image-p000000010-c000000010.sql.gz', ...
    (loop named chunk-set
      with file-name-head = (join (butlast (regexp:regexp-split
					    (regexp:regexp-quote ".")
					    file-name)
					   2)
				  ".")
      and  file-name-tail = (concatenate 'string
					 (format nil "-c~9,'0d.sql.gz"
						 *mirror-schunk-page-count*))
      ;; loop over `dump' fragments
      ;; `commonswiki-yyyymmdd-image.sql.gz000000000'
      for dump-frag-name of-type string
                         in (shell-ls-grep
			     *whereis-directory-wpmirror-working*
			     (format nil "~a0" file-name)
			     :put put)
      ;; a `page' is one `INSERT' statement
      as  page of-type integer from 0 by *mirror-schunk-page-count*
      ;; chunk file-names will look like
      ;; `commonswiki-yyyymmdd-image-p000000000-c000000010.sql.gz'
      as  file-name-page of-type string
                         = (format nil "-p~9,'0d" page) ; see <termination>
      as  chunk-name     of-type string
                         = (concatenate 'string         ; below for end-test
					file-name-head
					file-name-page
					file-name-tail)
      ;; creating one chunk
      count chunk-name into chunk-count
      do (debug-message-value (_ "chunks-generated") chunk-count)
         ;; 0) create record in `wpmirror.file' database table
         (sql-insert-file project wiki
			  language-code file-date
			  chunk-name "schunk"
			  :page page
			  :pages *mirror-schunk-page-count*
			  :put put)
	 ;; 1) rename file on disk
	 (debug-message-start (_ "renaming chunk"))
	 (put-message chunk-name :put put)
	 (when (probe-file chunk-name) ; overwrite if exists
	   (delete-file chunk-name))
	 (rename-file dump-frag-name chunk-name)
	 ;;(with-open-file (s chunk-name
	 ;;	            :direction :output
	 ;;		    :if-exists :supersede
	 ;;		    :if-does-not-exist :create)
	 ;;  (format s "START TRANSACTION;~%"))
	 ;;(shell-cat-append dump-frag-name chunk-name :put put)
	 ;;(shell-echo "COMMIT;" chunk-name :put put)
	 ;;(shell-remove-file dump-frag-name :put put)
	 (debug-message-done (_ "renaming chunk"))
	 ;; 2) update record in `wpmirror.file' database table
	 (when (ext:probe-pathname chunk-name)
	   (sql-update-file-size chunk-name :put put))))
  t)

(defun fsm-file-split-sql (file-name &key (put nil))
  "Splitting decompressed `sdump' file into `schunk's or `dchunk's"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |sql                 schunk or dchunk
  ;; state-in  |valid               n/a
  ;; state-out |pending             start
  ;; Return: nil means fail, t means done.
  ;;
  ;; Design note:
  ;;
  ;; 1) Sdumps like `simplewiki-yyyymmdd-image.sql.gz' consist of the
  ;; following sections:
  ;;
  ;; 1a) DBMS specific commands to save variable values, and reset them:
  ;;
  ;; /*!40101 SET @OLD_CHARACTER_SET_CLIENT=@@CHARACTER_SET_CLIENT */;
  ;; /*!40101 SET @OLD_CHARACTER_SET_RESULTS=@@CHARACTER_SET_RESULTS */;
  ;; /*!40101 SET @OLD_COLLATION_CONNECTION=@@COLLATION_CONNECTION */;
  ;; /*!40101 SET NAMES utf8 */;
  ;; /*!40103 SET @OLD_TIME_ZONE=@@TIME_ZONE */;
  ;; /*!40103 SET TIME_ZONE='+00:00' */;
  ;; /*!40014 SET @OLD_UNIQUE_CHECKS=@@UNIQUE_CHECKS, UNIQUE_CHECKS=0 */;
  ;; /*!40014 SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0 */;
  ;; /*!40101 SET @OLD_SQL_MODE=@@SQL_MODE, SQL_MODE='NO_AUTO_VALUE_ON_ZERO' */;
  ;; /*!40111 SET @OLD_SQL_NOTES=@@SQL_NOTES, SQL_NOTES=0 */;
  ;;
  ;; 1b) DROP TABLE and CREATE TABLE
  ;;
  ;; DROP TABLE IF EXISTS `image`;
  ;; /*!40101 SET @saved_cs_client     = @@character_set_client */;
  ;; /*!40101 SET character_set_client = utf8 */;
  ;; CREATE TABLE `image` (
  ;;  ...
  ;;
  ;; 1c) Data dump
  ;;
  ;; /*!40000 ALTER TABLE `image` DISABLE KEYS */;         <-- used by MyISAM
  ;; INSERT INTO `image` VALUES (...                       <-- we want these
  ;; INSERT INTO `image` VALUES (...                       <-- 
  ;; ...
  ;; /*!40000 ALTER TABLE `image` ENABLE KEYS */;          <-- used by MyISAM
  ;;
  ;; 1d) Restore DBMS variables
  ;;
  ;; /*!40103 SET TIME_ZONE=@OLD_TIME_ZONE */;
  ;; /*!40101 SET SQL_MODE=@OLD_SQL_MODE */;
  ;; /*!40014 SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS */;
  ;; /*!40014 SET UNIQUE_CHECKS=@OLD_UNIQUE_CHECKS */;
  ;; /*!40101 SET CHARACTER_SET_CLIENT=@OLD_CHARACTER_SET_CLIENT */;
  ;; /*!40101 SET CHARACTER_SET_RESULTS=@OLD_CHARACTER_SET_RESULTS */;
  ;; /*!40101 SET COLLATION_CONNECTION=@OLD_COLLATION_CONNECTION */;
  ;; /*!40111 SET SQL_NOTES=@OLD_SQL_NOTES */;
  ;;
  ;; 2) Files like `simplewiki-yyyymmdd-page-p000001000-c000001000.sql',
  ;; `simplewiki-yyyymmdd-revision-p000001000-c000001000.sql', and
  ;; `simplewiki-yyyymmdd-text-p000001000-c000001000.sql' are of type
  ;; `schunk' and not `sql', and therefore should not appear here.
  ;;
  ;; Such files are generated by `fsm-file-convert-xml2sql' from the `xchunk's
  ;; `simplewiki-yyyymmdd-stub-articles-p000001000-c000001000.xml', and
  ;; `simplewiki-yyyymmdd-pages-articles-p000001000-c000001000.xml'.
  ;;
  (cond ((string= *mirror-split-sql* "schunk")
	 (fsm-file-split-sql-to-sql file-name :put put))
	((string= *mirror-split-sql* "dchunk")
	 (fsm-file-split-sql-to-dat file-name :put put))
	(t (put-message-value-fail-and-abort (_ "Error: *mirror-split-sql*")
					     *mirror-split-sql*))))

(defun fsm-file-split-sql-to-dat (file-name &key (put nil))
  "Splitting decompressed sdump file into `dchunk's for LOAD DATA INFILE"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |sql                 dchunk (LOAD DATA INFILE)
  ;; state-in  |valid               n/a
  ;; state-out |pending             start
  ;; Return: nil means fail, t means done.
  ;;
  ;; Design note:
  ;;
  ;; `dchunk's are named like
  ;;   `simplewiki-yyyymmdd-image-p000000000-c000000010.dat'
  ;; `dchunk's are tabular data, and should be readable by:
  ;;
  ;; LOAD DATA INFILE `<path-name>`
  ;; IGNORE INTO TABLE `<database-name>`.`<table-name>`
  ;; FIELDS TERMINATED BY ',' OPTIONALLY ENCLOSED BY "'"
  ;; LINES TERMINATED BY '),(';
  ;;
  (let* ((project       (sql-select-file-project       file-name :put put))
	 (wiki          (sql-select-file-wiki          file-name :put put))
	 (language-code (sql-select-file-language-code file-name :put put))
	 (file-date     (sql-select-file-date          file-name :put put))
	 ;; `image.sql'
	 (table-ext     (third (regexp:regexp-split "-" file-name)))
	 ;; `image'
	 (table-name    (subseq table-ext 0 (- (length table-ext) 4)))
	 (insert-text   (format nil "INSERT INTO `~a` VALUES (" table-name))
	 (skip          (length insert-text)))
    (put-message-value insert-text skip :put put)
    (with-open-file (f file-name
		       :direction :input
		       :if-does-not-exist nil)
      ;; generating the set of chunks
      (loop named chunk-set
	with file-name-head = (join (butlast (regexp:regexp-split
					      (regexp:regexp-quote ".")
					      file-name))
				    ".")
	and  file-name-tail = (concatenate 'string
					   (format nil "-c~9,'0d.dat"
						   *mirror-dchunk-page-count*))
	and page            = 0 ; a `page' is one `INSERT' statement
	;; chunk file-names will look like
	;; `simplewiki-yyyymmdd-image-p000000000-c000000010.dat'
	for file-name-page of-type string
	                 = (format nil "-p~9,'0d" page) ; see <termination>
	as  chunk-name     of-type string
                         = (concatenate 'string         ; below for end-test
					file-name-head
					file-name-page
					file-name-tail)
	;; creating one chunk
	count chunk-name into chunk-count
	do (debug-message-value (_ "chunks-generated") chunk-count)
	   ;; 0) create record in `file' table of `wpmirror'
	   (sql-insert-file project wiki
			    language-code file-date
			    chunk-name "dchunk"
			    :page page
			    :pages *mirror-dchunk-page-count*
			    :put put)
	   ;; 1) create file on disk
	   (with-open-file (s chunk-name
			      :direction :output
			      :if-exists :supersede)
	     (loop named chunk
	       initially (debug-message-start (_ "creating chunk"))
	                 (put-message chunk-name :put put)
	       with chunk-page-count = 0
	       for line of-type string = (read-line f nil 'eof)
	                            then (read-line f nil 'eof)
               ;; 1a) line is EOF - goto `finally' clause below
	       until (eq line 'eof)
	       ;; 1b) line begins with INSERT - put data
	       when (and (> (length line) 6)
			 (string= (subseq line 0 6) "INSERT"))
;	       ;; remove leading `INSERT INTO `image' VALUES (' with `:start'
;	       ;; remove trailing `;'                           with `:end'
;	       ;; remove all `\n' with `write-string' instead of `write-line'
	       do   (write-string line s :start skip :end (- (length line) 1))
	            (write-string ",(" s)
	            (setq chunk-page-count (1+ chunk-page-count))
                    (setq page             (1+ page))
               ;; 1c) processed 100 INSERTs - goto `finally' clause below
	       until (eql chunk-page-count *mirror-dchunk-page-count*)
	       finally   (debug-message-done (_ "creating chunk"))
			 (when (eq line 'eof)
			   (return-from chunk-set t))) ; <termination>
	     t)
	   ;; 2) update record in `file' table of `wpmirror'
	   (when (ext:probe-pathname chunk-name)
	     (sql-update-file-size chunk-name :put put))))))

(defun fsm-file-split-sql-to-sql (file-name &key (put nil))
  "Splitting decompressed `sdump' file into `schunk's"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |sql                 schunk
  ;; state-in  |valid               n/a
  ;; state-out |pending             start
  ;; Return: nil means fail, t means done.
  ;;
  (let ((project       (sql-select-file-project       file-name :put put))
	(wiki          (sql-select-file-wiki          file-name :put put))
	(language-code (sql-select-file-language-code file-name :put put))
	(file-date     (sql-select-file-date          file-name :put put)))
    (with-open-file (f file-name
		       :direction :input
		       :if-does-not-exist nil)
      ;; generating the set of chunks
      (loop named chunk-set
	with file-name-head = (join (butlast (regexp:regexp-split
					      (regexp:regexp-quote ".")
					      file-name))
				    ".")
	and  file-name-tail = (concatenate 'string
					   (format nil "-c~9,'0d.sql"
						   *mirror-schunk-page-count*))
	and page            = 0 ; a `page' is one `INSERT' statement
	;; chunk file-names will look like
	;; `simplewiki-yyyymmdd-category-p000000000-c000000010.sql'
	for file-name-page of-type string
	                 = (format nil "-p~9,'0d" page) ; see <termination>
	as  chunk-name     of-type string
                         = (concatenate 'string         ; below for end-test
					file-name-head
					file-name-page
					file-name-tail)
	;; creating one chunk
	count chunk-name into chunk-count
	do (debug-message-value (_ "chunks-generated") chunk-count)
	   ;; 0) create record in `file' table of `wpmirror'
	   (sql-insert-file project wiki
			    language-code file-date
			    chunk-name "schunk"
			    :page page
			    :pages *mirror-schunk-page-count*
			    :put put)
	   ;; 1) create file on disk
	   (with-open-file (s chunk-name
			      :direction :output
			      :if-exists :supersede)
	     (loop named chunk
	       initially (debug-message-start (_ "creating chunk"))
	                 (put-message chunk-name :put put)
			 (write-line "SET autocommit=0;" s)
	       with chunk-page-count = 0
	       for line of-type string = (read-line f nil 'eof)
	                            then (read-line f nil 'eof)
               ;; 1a) line is EOF - goto `finally' clause below
	       until (eq line 'eof)
	       ;; 1b) line begins with INSERT - use REPLACE
	       when (and (> (length line) 6)
			 (string= (subseq line 0 6) "INSERT"))
	       do   (write-string "REPLACE" s)
	            (write-line line s :start 6)
	            (setq chunk-page-count (1+ chunk-page-count))
                    (setq page             (1+ page))
               ;; 1c) processed 100 INSERTs - goto `finally' clause below
	       until (eql chunk-page-count *mirror-schunk-page-count*)
	       finally   (debug-message-done (_ "creating chunk"))
	                 (write-line "COMMIT;" s)
			 (when (eq line 'eof)
			   (return-from chunk-set t))) ; <termination>
	     t)
	   ;; 2) update record in `file' table of `wpmirror'
	   (when (ext:probe-pathname chunk-name)
	     (sql-update-file-size chunk-name :put put))))))

(defun fsm-file-split-xdump (file-name &key (put nil))
  "Splitting `xdump' file into `xchunk's"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |xdump,xincr         xchunk
  ;; state-in  |valid               n/a
  ;; state-out |pending             start
  ;; Return: nil means fail, t means done.
  ;;
  ;; Design note:
  ;;
  ;; 1) `Xdump's like `simplewiki-yyyymmdd-pages-articles.xml.bz2'
  ;; consist of the following sections:
  ;;
  ;; <mediawiki xmlns="http://www.mediawiki.org/xml/export-0.8/"
  ;; xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
  ;; xsi:schemaLocation="http://www.mediawiki.org/xml/export-0.8/
  ;; http://www.mediawiki.org/xml/export-0.8.xsd" version="0.8"
  ;; xml:lang="en">
  ;;  <siteinfo>
  ;;    <sitename>Wikipedia</sitename>
  ;;    <base>http://simple.wikipedia.org/wiki/Main_Page</base>
  ;;    <generator>MediaWiki 1.24wmf1</generator>
  ;;    <case>first-letter</case>
  ;;    <namespaces>
  ;;      <namespace key="-2" case="first-letter">Media</namespace>
  ;;      <namespace key="-1" case="first-letter">Special</namespace>
  ;;      <namespace key="0" case="first-letter" />
  ;;      <namespace key="1" case="first-letter">Talk</namespace>
  ;;      <namespace key="2" case="first-letter">User</namespace>
  ;;      <namespace key="3" case="first-letter">User talk</namespace>
  ;;      <namespace key="4" case="first-letter">Wikipedia</namespace>
  ;;      <namespace key="5" case="first-letter">Wikipedia talk</namespace>
  ;;      <namespace key="6" case="first-letter">File</namespace>
  ;;      <namespace key="7" case="first-letter">File talk</namespace>
  ;;      <namespace key="8" case="first-letter">MediaWiki</namespace>
  ;;      <namespace key="9" case="first-letter">MediaWiki talk</namespace>
  ;;      <namespace key="10" case="first-letter">Template</namespace>
  ;;      <namespace key="11" case="first-letter">Template talk</namespace>
  ;;      <namespace key="12" case="first-letter">Help</namespace>
  ;;      <namespace key="13" case="first-letter">Help talk</namespace>
  ;;      <namespace key="14" case="first-letter">Category</namespace>
  ;;      <namespace key="15" case="first-letter">Category talk</namespace>
  ;;      <namespace key="828" case="first-letter">Module</namespace>
  ;;      <namespace key="829" case="first-letter">Module talk</namespace>
  ;;    </namespaces>
  ;;  </siteinfo>
  ;;  <page>
  ;;    <title>April</title>
  ;;    <ns>0</ns>
  ;;    <id>1</id>
  ;;    <revision>
  ;;      <id>4784983</id>
  ;;      <parentid>4657771</parentid>
  ;;      <timestamp>2014-04-18T02:15:54Z</timestamp>
  ;;      <contributor>
  ;;        <ip>61.199.127.79</ip>
  ;;      </contributor>
  ;;      <comment>made the grammar better</comment>
  ;;      <text xml:space="preserve">{{monththisyear|4}}
  ;; '''April''' is the fourth [[month]] of the [[year]], and comes between
  ;; [[March]]...
  ;; ...
  ;; {{Months}}</text>
  ;;      <sha1>jk9e5is1yxp1resnscpooes74s5fnc1</sha1>
  ;;      <model>wikitext</model>
  ;;      <format>text/x-wiki</format>
  ;;    </revision>
  ;;  </page>
  ;;  ...
  ;; </mediawiki>
  ;;
  ;; 2) The `<mediawiki>' tag includes attributes which describe the
  ;; `XML' schema (`export-0.8.xsd'). The `<siteinfo>' tag contains
  ;; `<namespace>' tags. This header must be included in each
  ;; `xchunk'.
  ;;
  ;; 3) The `<page>' tags contain the individual pages and
  ;; articles. Each `xchunk' should contain 1,000 (default) pages. For
  ;; the top-ten largest wikipedias (plus the `commonswiki' and
  ;; `wikidatawiki'), each `xchunk' should contain 10,000 (default)
  ;; pages.
  ;;
  ;; Design note:
  ;;
  ;; 1) Files like `simplewiki-yyyymmdd-stub-articles.xml.gz' will be
  ;; split the same way as files like
  ;; `simplewiki-yyyymmdd-pages-articles.xml.bz2'.  However, the
  ;; `stub' split files are not be recorded in the `wpmirror.file'
  ;; state table as `xchunk's.  This is because their only use is to
  ;; exist along side the corresponding `pages-articles' split files
  ;; (`xchunk's).  Both must be present for `fsm-file-convert-xml2sql'
  ;; to run.
  ;;
  (let* ((wiki              (sql-select-file-wiki          file-name :put put))
	 (xchunk-page-count (mirror-xchunk-page-count      wiki      :put put)))
    ;; 1) do `zgrep-replace-split' into files named like:
    ;;   `simplewiki-yyyymmdd-pages-articles.xml.bz2000000000',
    ;;   `simplewiki-yyyymmdd-pages-articles.xml.bz2000000001', ...
    (shell-split-xdump-to-xchunk file-name xchunk-page-count :put put)
    ;; 2) rename `xchunks' to read like:
    ;;   `simplewiki-yyyymmdd-pages-articles-p000000000-c000001000.xml.bz2',
    ;;   `simplewiki-yyyymmdd-pages-articles-p000001000-c000001000.xml.bz2', ...
    (rename-xchunk               file-name xchunk-page-count :put put)))

(defun rename-xchunk (file-name xchunk-page-count &key (put nil))
  "Renaming `xchunk's resulting from `xdump' split"
  ;;
  ;; Design note:
  ;;
  ;; Problem. `xdump's and `xincr's often contain corrupt records. In
  ;; addition, `mwxml2sql' and `importDump.php' are not well
  ;; supported.
  ;;
  ;; Solution.
  ;;   1) Split `xdump's and `xincr's into smaller `xchunk's;
  ;;   2) import `xchunk's (expect some to fail);
  ;;   3) split failed `xchunk's into yet smaller `xchunk's; and
  ;;   4) return to step 2.
  ;; What remains will be a set of failed `xchunk's, each containing
  ;; just one bad record.
  ;;
  ;; Renaming. This routine only performs renaming of split files.
  ;;
  ;; There are two cases to consider.
  ;;
  ;; 1) `xdump' or `xincr'. If `file-name' is that of an `xdump' or
  ;; `xincr', then the split will generate `xchunk's with names like
  ;;   `simplewiki-yyyymmdd-pages-articles.xml.bz2000000000',
  ;;   `simplewiki-yyyymmdd-pages-articles.xml.bz2000000001', ...
  ;; which must be renamed with `page-begin' and `page-count' info
  ;; like
  ;;                                       page-begin page-count
  ;;   `simplewiki-yyyymmdd-pages-articles-p000000000-c000001000.xml.bz2',
  ;;   `simplewiki-yyyymmdd-pages-articles-p000001000-c000001000.xml.bz2', ...
  ;;
  ;; 2) `xchunk'. If `file-name' is that of an `xchunk' (usually an
  ;; `xchunk' that failed to be imported), then the split will
  ;; generate smaller `xchunk's with names like
  ;;                                       page-begin page-count
  ;;   `simplewiki-yyyymmdd-pages-articles-p000000000-c000001000.xml.bz2000000000',
  ;;   `simplewiki-yyyymmdd-pages-articles-p000000000-c000001000.xml.bz2000000001', ...
  ;; which must be renamed with updated `page-begin' and
  ;; `page-count' info like page-begin page-count
  ;;   `simplewiki-yyyymmdd-pages-articles-p000000000-c000000100.xml.bz2',
  ;;   `simplewiki-yyyymmdd-pages-articles-p000000100-c000000100.xml.bz2', ...
  ;;
  ;; Design note:
  ;;
  ;; The `sort' in `(sort (shell-ls-grep ...) #'string-lessp)' is
  ;; necessary. Without `sort' the numbering of the `xchunk's from
  ;; `pages-articles' and `stub-articles' will not match up.
  ;;
  (let* ((project        (sql-select-file-project       file-name :put put))
	 (wiki           (sql-select-file-wiki          file-name :put put))
	 (language-code  (sql-select-file-language-code file-name :put put))
	 (file-date      (sql-select-file-date          file-name :put put))
	 (file-ext       (file-name-to-extension        file-name :put put))
	 (file-type      (sql-select-file-type          file-name :put put))
	 ;; `xdump' :`simplewiki-yyyymmdd-pages-articles', or
	 ;; `xchunk':`simplewiki-yyyymmdd-pages-articles-p000000000-c000001000'
	 (file-name-tmp  (join (butlast (regexp:regexp-split
					 (regexp:regexp-quote ".")
					 file-name)
					2)
			       "."))
	 (xchunk-p       (string= file-type "xchunk"))
	 ;; `xdump' :`simplewiki-yyyymmdd-pages-articles' => 0, or
	 ;; `xchunk':`simplewiki-yyyymmdd-pages-articles-p000000000-c000001000'
	 ;;          split, last 2                   ("p000000000" "c000001000")
	 ;;          first, string-left-trim, read     "000000000" => 0
	 (xchunk-page-begin (if xchunk-p
			     (read-from-string
			      (string-left-trim "p"
			       (first
				(last
				 (regexp:regexp-split "-" file-name-tmp ) 2))))
			      0))
	 ;; `xdump' :`simplewiki-yyyymmdd-pages-articles'
	 ;; `xchunk':`simplewiki-yyyymmdd-pages-articles'
	 (file-name-head (if xchunk-p
			     (join (butlast (regexp:regexp-split
					     "-"
					     file-name-tmp)
					    2)
			      "-")
			   file-name-tmp))
	 (tail-format    (case file-ext
			       (:bz2 "-c~9,'0d.xml.bz2")
			       (:gz  "-c~9,'0d.xml.gz")
			       (t    (put-message-value-fail-and-abort
				      (_ "unknown file extension") file-name))))
	 (file-name-tail (concatenate 'string
				      (format nil tail-format
					      xchunk-page-count)))
	 (stub-p         (regexp:match "stub"           file-name)))
    (loop named chunk-set
      ;; loop over `dump' fragments
      ;; `simplewiki-yyyymmdd-pages-articles.xml.bz2000000000'
      ;; `simplewiki-yyyymmdd-stub-articles.xml.gz000000000'
      for dump-frag-name of-type string
                         in (sort (shell-ls-grep
				   *whereis-directory-wpmirror-working*
				   (format nil "~a0" file-name)
				   :put put)
				  #'string-lessp)
      ;; a `page' is one `<page>' ... `</page>' element
      as  page of-type integer from xchunk-page-begin by xchunk-page-count
      ;; chunk file-names will look like
      ;; `simplewiki-yyyymmdd-pages-articles-p000000000-c000001000.xml.bz2'
      ;; `simplewiki-yyyymmdd-stub-articles-p000000000-c000001000.xml.gz'
      as  file-name-page of-type string
                         = (format nil "-p~9,'0d" page) ; see <termination>
      as  chunk-name     of-type string
                         = (concatenate 'string         ; below for end-test
					file-name-head
					file-name-page
					file-name-tail)
      ;; creating one chunk
      count chunk-name into chunk-count
      do (debug-message-value (_ "chunks-generated") chunk-count)
         ;; 0) create record in `wpmirror.file' database table
	 (unless stub-p
	   (sql-insert-file project wiki
			    language-code file-date
			    chunk-name "xchunk"
			    :page page
			    :pages xchunk-page-count
			    :put put))
	 ;; 1) rename file on disk
	 (debug-message-start (_ "renaming chunk"))
	 (put-message chunk-name :put put)
	 (when (probe-file chunk-name) ; overwrite if exists
	   (delete-file chunk-name))
	 (rename-file dump-frag-name chunk-name)
	 (debug-message-done (_ "renaming chunk"))
	 ;; 2) update record in `wpmirror.file' database table
	 (unless stub-p
	   (when (ext:probe-pathname chunk-name)
	     (sql-update-file-size chunk-name :put put)))))
  t)

(defun fsm-file-split-xml (file-name &key (put nil))
  "Splitting decompressed xdump file into `xchunk's"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |xml                 xchunk
  ;; state-in  |valid               n/a
  ;; state-out |pending             start
  ;; Return: nil means fail, t means done.
  ;;
  ;; Design note:
  ;;
  ;; Files like `simplewiki-yyyymmdd-stub-articles.xml' will be split
  ;; the same way as files like
  ;; `simplewiki-yyyymmdd-pages-articles.xml'.
  ;;
  ;; However, the `stub' split files are not be recorded in the
  ;; `wpmirror.file' state table as `xchunk's.  This is because their
  ;; only use is to exist along side the corresponding
  ;; `pages-articles' split files (`xchunk's).  Both must be present
  ;; for `fsm-file-convert-xml2sql' to run.
  ;;
  (let* ((project       (sql-select-file-project       file-name :put put))
	 (wiki          (sql-select-file-wiki          file-name :put put))
	 (language-code (sql-select-file-language-code file-name :put put))
	 (xchunk-page-count (mirror-xchunk-page-count  wiki      :put put))
	 (file-date     (sql-select-file-date          file-name :put put))
	 (stub-p        (regexp:match "stub" file-name))
	 (title-pattern (regexp:regexp-compile
			 "^    <title>[^<]*:[^<]*</title>$")))
    (with-open-file (f file-name
		       :direction :input
		       :if-does-not-exist nil)
      ;; generating the set of chunks
      (loop named chunk-set
	with mediawiki-tag-start = (read-line f nil nil) ; <mediawiki ...>
	and  siteinfo-lines      = (loop                 ;   <siteinfo>
				    for sil of-type string =
				                         (read-line f nil 'eof)
				                    then (read-line f nil 'eof)
				    collect sil
				    until (string= sil "  </siteinfo>"))
	and  mediawiki-tag-end   = "</mediawiki>"
	and  file-name-head      = (join (butlast (regexp:regexp-split
						   (regexp:regexp-quote ".")
						   file-name))
					 ".")
	and  file-name-tail      = (concatenate 'string
						(format nil "-c~9,'0d.xml"
						   xchunk-page-count))
	and page                 = 0
	;; chunk file-names will look like
	;; `simplewiki-yyyymmdd-pages-articles-p000000000-c000001000.xml'
	for file-name-page of-type string
	                 = (format nil "-p~9,'0d" page) ; see <termination>
	as  chunk-name     of-type string
                         = (concatenate 'string         ; below for end-test
					file-name-head
					file-name-page
					file-name-tail)
	;; creating one chunk
	count chunk-name into chunk-count
	do (debug-message-value (_ "chunks-generated") chunk-count)
	   ;; 0) create record in `file' table of `wpmirror'
	   (unless stub-p
	     (sql-insert-file project wiki
			      language-code file-date
			      chunk-name "xchunk"
			      :page page
			      :pages xchunk-page-count
			      :put put))
	   ;; 1) create file on disk
	   (with-open-file (x chunk-name
			      :direction :output
			      :if-exists :supersede)
	     (loop named chunk
	       initially (debug-message-start (_ "creating chunk"))
	                 (put-message chunk-name :put put)
			 (write-line mediawiki-tag-start x)  ; <mediawiki ...>
			 (loop                               ;   <siteinfo>
			  for sil in siteinfo-lines          ;   ...
			  do (write-line sil x))             ;   </siteinfo>
	       with chunk-page-count = 0
	       for l of-type string = (read-line f nil 'eof)
                                 then (read-line f nil 'eof)
	       when (eq l 'eof) do (return-from chunk-set t) ; <termination>
	       ;; correct <title> errors
	       ;;when (regexp:regexp-exec title-pattern l)
	       ;;do   (setq l (page-title-edit l :put put))
	       ;; write line to file
	       do   (write-line l x)
	       when (string= l "  </page>")
	       do   (setq chunk-page-count (1+ chunk-page-count))
                    (setq page             (1+ page))
	       until (eql chunk-page-count xchunk-page-count)
	       finally   (write-line mediawiki-tag-end   x)
	                 (debug-message-done (_ "creating chunk")))
	     t)
	   ;; 2) update record in `wpmirror.file' database table
	   (unless stub-p
	     (when (ext:probe-pathname chunk-name)
	       (sql-update-file-size chunk-name :put put)))))))

(defun fsm-file-validate (file-name &key (put nil))
  "Validating downloaded xdump,sdump file against known checksum"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |xdump,sdump         none
  ;; state-in  |created             
  ;; state-out |valid               
  ;; Return: nil means fail, t means done.
  (let* ((dump-checksum-should (sql-select-file-md5sum file-name :put put))
	 (dump-checksum-actual (shell-md5sum           file-name :put put)))
    ;; 1) update `size' just in case the dump file was manually downloaded
    ;;    into the working directory
    (sql-update-file-size file-name :put put)
    ;; 2) compare known checksum with actual checksum
    (put-message-value (_ "checksum should be")   dump-checksum-should :put put)
    (put-message-value (_ "checksum actually is") dump-checksum-actual :put put)
    (string= dump-checksum-should dump-checksum-actual)))

(defun fsm-file-wget (ichunk-name &key (put nil))
  "Downloading images for given `ichunk'"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |ichunk              image files
  ;; state-in  |valid               n/a
  ;; state-out |pending
  ;; Return: nil means fail, t means done.
  ;;
  ;; Design note:
  ;;
  ;; This function:
  ;;   o changes CWD to the working directory (if not already there),
  ;;   o copies the ichunk to the `images' directory,
  ;;   o changes CWD to the `images' directory,
  ;;   o probes that the copy is there,
  ;;   o runs `wget' on the copied file (which contains image file URLs),
  ;;   o removes the copy, and finally
  ;;   o changes CWD back to the working directory,
  ;; where CWD means `current working directory'.
  ;;
  (let* ((path-name *whereis-directory-mediawiki-images*)
	 (file-size (download-file-size-local ichunk-name :put put))
	 (r         nil)) ; result
    (debug-message ichunk-name)
    (ext:cd *whereis-directory-wpmirror-working*)
    (debug-message-value (_ "copying") ichunk-name)
    (setq r (null (shell-copy-file ichunk-name path-name :put put)))
    (when r
      (debug-message-value (_ "changing to images directory")
			   path-name)
      (ext:cd path-name)
      (debug-message-value (_ "current working directory is now")
			   (ext:cd))
      (debug-message-value (_ "probing") (ext:probe-pathname ichunk-name))
      (setq r (ext:probe-pathname ichunk-name))
      (when r
	(debug-message-value (_ "running wget on")
			     (ext:probe-pathname ichunk-name))
	(when (> file-size 0)
	  (setq r (null (shell-wget-input-file ichunk-name :put put))))
	(debug-message-value (_ "removing")
			     (ext:probe-pathname ichunk-name))
	(shell-remove-file ichunk-name :put put)))
    (debug-message-value (_ "changing to working directory")
			 *whereis-directory-wpmirror-working*)
    (ext:cd *whereis-directory-wpmirror-working*)
    (debug-message-value (_ "current working directory is now") (ext:cd))
    (when (> file-size 0)
      (put-flag-message :info (_ "done")))
    r))

(defun fsm-file-process-xml (xchunk-name &key (put nil))
  "Converting or importing `xchunk'"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-name |xchunk              schunks or none
  ;; state-in  |pending             n/a
  ;; state-out |done
  ;; Return: nil means fail, t means done.
  ;;
  ;; Design note:
  ;;
  ;; Problem.  `importDump.php' is slow.
  ;;
  ;; Solution.  Prefer `xml2sql'.
  ;;
  ;; Problem.  `xml2sql' works badly with `xincr's (e.g. fails for
  ;; pages in liquid threads namespace).
  ;;
  ;; Solution.  Use `import'.
  ;;
  (let ((match-xincr  (regexp:match "incr" xchunk-name)))
    ;; `xincr' - use `import'
    (if (not (null match-xincr))
	(fsm-file-import-xml-or-split      xchunk-name :put put)
    ;; `xdump' - use `xml2sql' (default)
      (case *mirror-process-xml*
	    (:import   (fsm-file-import-xml      xchunk-name :put put))
	    (:thumb    (fsm-file-import-xml      xchunk-name :put put))
	    (:xml2sql  (fsm-file-convert-xml2sql xchunk-name :put put))
	    (otherwise (put-message-value-fail-and-abort
			(_ "Error: *mirror-process-xml*")
			*mirror-process-xml*))))))

(defun fsm-file-import-xml-or-split (xchunk-name &key (put nil))
  "Importing `xchunk' into wiki database, else splitting into smaller `xchunk's"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-name |xchunk              none, else smaller xchunks
  ;; state-in  |pending             n/a
  ;; state-out |done
  ;; Return: nil means fail, t means done.
  ;;
  ;; Design note:
  ;;
  ;; A failed `xchunk' should be split into smaller `xchunk's. The
  ;; page-count of these smaller `xchunk's will be a power of ten.
  ;;
  ;; page-count page-count-10
  ;; ----------+-------------
  ;;      20000         10000
  ;;      10000          1000
  ;;       1000           100
  ;;        100            10
  ;;         10             1
  ;;          1             1 <- stop recursion here
  ;;
  ;; Currently, this routine does not split `stub' or `stubs'.
  ;;
  (let* ((succeed-p            (fsm-file-import-xml xchunk-name :put put))
	 (wiki                 (file-name-to-wiki   xchunk-name :put put))
	 (xchunk-page-count    (file-name-to-pages  xchunk-name :put put))
	 (xchunk-page-count-10 (if (<= xchunk-page-count 1)
				   1
				 (expt 10 (truncate
					   (log (1- xchunk-page-count) 10))))))
    (if (and (not succeed-p)
	     ;; wmf/1.24wmf8 `importDump.php' fails to import `wikidatawiki'
	     (not (string= wiki "wikidatawiki"))
	     (> xchunk-page-count 1))
	(progn
	  ;; 1) do `zgrep-replace-split' into files named like:
	  ;;   `simplewiki-yyyymmdd-pages-articles.xml.bz2000000000',
	  ;;   `simplewiki-yyyymmdd-pages-articles.xml.bz2000000001', ...
	  (shell-split-xdump-to-xchunk xchunk-name xchunk-page-count-10
				       :put put)
	  ;; 2) rename `xchunks' to read like:
	  ;;   `simplewiki-yyyymmdd-pages-articles-p000000000-c000001000.xml.bz2',
	  ;;   `simplewiki-yyyymmdd-pages-articles-p000001000-c000001000.xml.bz2', ...
	  (rename-xchunk               xchunk-name xchunk-page-count-10
				       :put put)) ; <- returns t
      succeed-p)))

(defun fsm-file-import-xml (xchunk-name &key (put nil))
  "Importing `xchunk' into wiki database"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-name |xchunk              none
  ;; state-in  |pending             n/a
  ;; state-out |done
  ;; Return: nil means fail, t means done.
  ;;
  ;; Design note:
  ;;
  ;; Problem:
  ;;
  ;; o `mwxml2sql' is fast, buggy, and not well supported.
  ;; o `importDump.php' is slow, accurate, and well supported.
  ;; o `*mirror-process-xml*' is set to `:xml2sql' (default), `:import',
  ;;   `:media', or `:thumb'.
  ;;
  ;; Solution:
  ;;
  ;; Use the fallback method: First try `mwxml2sql'. Then, if that
  ;; fails, fall back on `importDump.php'.
  ;;
  ;; 1) The FSM invokes `fsm-file-process-xml' (this function) to
  ;; process `xchunk's. If `*mirror-process-xml*' is set to
  ;; `:xml2sql', then it tries:
  ;;
  ;; 2) Default. `fsm-file-convert-xml2sql' is invoked to process the
  ;; `xchunk' using `mwxml2sql'. If `mwxml2sql' fails to convert an
  ;; `xchunk' into valid SQL, then `fsm-file-convert-xml2sql' returns
  ;; nil, as does this function, and the FSM sets the `xchunk's state
  ;; to `fail'.
  ;;
  ;; 3) Fallback. When the FSM completes all other tasks, it sets
  ;; `*mirror-process-xml*' to `:import', and then retries the
  ;; `fail'ed `xchunk'. `fsm-file-process-xml' (this function) then
  ;; invokes `fsm-file-import-xml' to process the `xchunk' using
  ;; `importDump.php'.
  ;;
  (debug-message-value (_ "xchunk-name") xchunk-name)
  (let ((result       nil))
    (put-message xchunk-name :put put)
    (setq result (not (shell-mediawiki-farm-importdump xchunk-name :put put)))
    (put-flag-message :info (_ "done"))
    result))

(defun fsm-file-convert-xml2sql (xchunk-name &key (put nil))
  "Converting `xchunk' into set of `schunk's"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |xchunk              schunk (page, revision, text)
  ;; state-in  |pending
  ;; state-out |done
  ;; Return: nil means fail, t means done.
  ;;
  ;; Design Note:
  ;;
  ;; 1) Files like
  ;; `simplewiki-yyyymmdd-page-p000001000-c000001000.sql',
  ;; `simplewiki-yyyymmdd-revision-p000001000-c000001000.sql', and
  ;; `simplewiki-yyyymmdd-text-p000001000-c000001000.sql' are of type
  ;; `schunk' and not `sql', and therefore should not appear here.
  ;;
  ;; Such files are generated by `mwxml2sql' from the `xchunk's
  ;; `simplewiki-yyyymmdd-pages-articles-p000001000-c000001000.xml', and
  ;; `simplewiki-yyyymmdd-stub-articles-p000001000-c000001000.xml'.
  ;;
  ;; They consist of the following sections:
  ;; 
  ;; 1a) Comments
  ;;
  ;; -- MediaWiki XML dump converted to SQL by mwxml2sql version 0.0.2
  ;; -- MediaWiki XML dump schema 0.8
  ;; --
  ;; -- Sitename: Wikipedia
  ;; -- Base url: http://simple.wikipedia.org/wiki/Main_Page
  ;; -- XML dump generated by: MediaWiki 1.23wmf18
  ;; -- Case sensitivity: first-letter
  ;;
  ;; 1b) Data
  ;;
  ;; BEGIN;
  ;; INSERT  INTO page (page_id, ...) VALUES
  ;; (3139, ...),
  ;; (3140, ...),
  ;; ...
  ;; (4422, ...);
  ;; COMMIT;
  ;;
  (let* ((project       (sql-select-file-project       xchunk-name :put put))
	 (wiki          (sql-select-file-wiki          xchunk-name :put put))
	 (language-code (sql-select-file-language-code xchunk-name :put put))
	 (xchunk-page-count (mirror-xchunk-page-count  wiki        :put put))
	 (date          (sql-select-file-date          xchunk-name :put put))
	 (page          (sql-select-file-page          xchunk-name :put put))
	 (pages         (sql-select-file-pages         xchunk-name :put put))
	 (range         (format nil "p~9,'0d-c~9,'0d" page
				xchunk-page-count))
	 (xchunk-name-stub       (format nil "~a-~a-stub-~a-~a.xml.gz"
					 wiki date
					 (wikimedia-xdump-type-string :put put)
					 range))
	 (file-name-template     (format nil "~a-~a-~a.gz"
					   wiki date range))
	 (file-name-createtables (format nil "~a-~a-~a-createtables.sql-~a.gz"
					 wiki date range *mediawiki-version*))
	 (file-name-page         (format nil "~a-~a-~a-page.sql-~a.gz"
					 wiki date range *mediawiki-version*))
	 (file-name-revision     (format nil "~a-~a-~a-revision.sql-~a.gz"
					 wiki date range *mediawiki-version*))
	 (file-name-text         (format nil "~a-~a-~a-text.sql-~a.gz"
					 wiki date range *mediawiki-version*))
	 (file-name-list         (list file-name-page
				       file-name-revision
				       file-name-text))
	 (pattern                "^(")
	 (count-page             0)
	 (count-revision         0)
	 (schunk-name-page       (format nil "~a-~a-page-~a.sql.gz"
					 wiki date range))
	 (schunk-name-revision   (format nil "~a-~a-revision-~a.sql.gz"
					 wiki date range))
	 (schunk-name-text       (format nil "~a-~a-text-~a.sql.gz"
					 wiki date range))
	 (schunk-name-list       (list schunk-name-page
				       schunk-name-revision
				       schunk-name-text))
	 (stub-p        (regexp:match "stub" xchunk-name))
	 (sql-command-list       (list "REPLACE"
				       "INSERT IGNORE"
				       "INSERT IGNORE"))
	 (lines                  nil)
	 (whine-p                nil)
	 (result                 t))
    (unless stub-p
      (debug-message xchunk-name)
      (debug-message schunk-name-page)
      ;; 1) generate `sql' files from `xchunk' and `stub'
      (setq lines
	    (shell-mwxml2sql xchunk-name-stub xchunk-name file-name-template
			     :put put))
      (setq whine-p
	    (loop
	     for line in lines
	     thereis (regexp:match "WHINE" line)))
      (when whine-p
	  (put-message-value-fail (_ "WHINE") lines)
	  (setq result nil))
      (when result
	;; 2) convert `sql' files to `schunk'
	(loop
	 for file-name   in file-name-list
	 as  schunk-name in schunk-name-list
	 as  sql-command in sql-command-list
	 do (shell-zcat-replace file-name "INSERT" sql-command schunk-name
				:put put)
	 finally (debug-message-done (_ "creating schunk")))
	;; 3) delete
	(loop
	 for file-name   in file-name-list
	 do (shell-remove-file   file-name   :put put)
	 finally (shell-remove-file file-name-createtables  :put put))
	;; 4) insert `schunk' state info for `page', `revision', and `text'
	(loop
	 for schunk-name in schunk-name-list
	 do (sql-insert-file project wiki
			     language-code date
			     schunk-name "schunk"
			     :page page :pages pages :put put)
	    (sql-update-file-size schunk-name :put put))))
    result))

(defun fsm-function (file-type file-state &key (put nil))
  "Determining function to use according to *type-state-function* table"
  (debug-message-value (_ "file type, state")
		       (format nil "~a, ~a" file-type file-state))
  (unless (member file-type *type* :test #'string=)
    (put-message-value-fail-and-abort (_ "Error: FSM invalid type") file-type))
  (unless (member file-state *state* :test #'string=)
    (put-message-value-fail-and-abort (_ "Error: FSM invalid state") file-state))
  (dolist (tuple *type-state-function* nil)
    (when (and (string= file-type  (first  tuple))
	       (string= file-state (second tuple)))
      (progn
	(put-message-value (_ "file type, state, and function")
			   (format nil "~a, ~a, ~a" 
				   (first  tuple)      ; type
				   (second tuple)      ; state
				   (third  tuple))     ; function
			   :put put)
	(return (third tuple)))))) ; break loop        ; <--- return function
				       
(defun fsm-images-directory (file-name &key (put nil))
  "Creating directory for image files"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |images              n/a
  ;; state-in  |pending             
  ;; state-out |done                
  ;; Return: nil means fail, t means done.
  ;;
  ;; Given: file name `simplewiki-images'
  ;; Create: directories:
  ;;         `/var/lib/wp-mirror-mediawiki/images/wikipedia/simple/'
  ;;         `/var/lib/wp-mirror-mediawiki/images/wikipedia/simple/lilypond/'
  ;;         `/var/lib/wp-mirror-mediawiki/images/wikipedia/simple/math/'
  ;;         `/var/lib/wp-mirror-mediawiki/images/wikipedia/simple/thumb/'
  ;;         `/var/lib/wp-mirror-mediawiki/images/wikipedia/simple/timeline/'
  ;;         `/var/lib/wp-mirror-mediawiki/images/wikipedia/simple/tmp/'
  ;;         `/var/lib/wp-mirror-mediawiki/images/wikipedia/commons/'
  ;;         `/var/lib/wp-mirror-mediawiki/images/wikipedia/commons/thumb/'
  ;; 
  (debug-message-value (_ "file-name") file-name)
  (let* ((project       (sql-select-file-project       file-name :put put))
	 (language-code (sql-select-file-language-code file-name :put put)))
    (and 
     (assert-images-lilypond-directory-or-create-p
                                                project language-code :put put)
     (assert-images-math-directory-or-create-p  project language-code :put put)
     (assert-images-thumb-directory-or-create-p project language-code :put put)
     (assert-images-timeline-directory-or-create-p
                                                project language-code :put put)
     (assert-images-tmp-directory-or-create-p   project language-code :put put)
     (assert-images-thumb-directory-or-create-p "wikipedia" *mirror-commons*
						:put put)
     )))

(defun fsm-no-op (file-name &key (put nil))
  "Doing nothing"
  ;; Files and states:
  ;;           |input file          generated file(s)
  ;; ----------+-------------------+--------------------------
  ;; file-type |don't care          none
  ;; state-in  |don't care             
  ;; state-out |no change               
  ;; Return: nil means fail, t means done.
  t) ; never fails

(defun assert-partition-free-images (&key (put nil))
  "Asserting image partition free space exceeds threshold"
  (let* ((partition-free-images (system-partition-free-images :put put))
	 (val (format
	       nil "~a/~a"
	       (format-integer-for-human partition-free-images)
	       (format-integer-for-human *system-partition-free-images-min*)))
	 (freep (> partition-free-images *system-partition-free-images-min*)))
    (if freep
	(put-message-value (_ "images space above threshold") val :put put)
      (put-message-value-fail-2 (_ "images space below threshold")
				(format nil "~a, skip image download" val)))
    freep))

(defun assert-partition-free-innodb (&key (put nil))
  "Asserting InnoDB partition free space exceeds threshold"
  (let* ((partition-free-innodb (system-partition-free-innodb :put put))
	 (val (format
	       nil "~a/~a"
	       (format-integer-for-human partition-free-innodb)
	       (format-integer-for-human *system-partition-free-innodb-min*)))
	 (freep (> partition-free-innodb *system-partition-free-innodb-min*)))
    (if freep
	(put-message-value (_ "innodb space above threshold") val :put put)
      (put-message-value-fail-2 (_ "innodb space below threshold")
				(format nil "~a, skip page import" val)))
    freep))

(defun fsm-process-file (file-name &key (put nil))
  "Processing file with finite-state-machine"
  (let ((message (_ "processing file with finite-state-machine"))
	(wiki      (sql-select-file-wiki  file-name :put put))
	(file-type (sql-select-file-type  file-name :put put))
	(state-old (sql-select-file-state file-name :put put))
	(state-new "error")
	(input     "error")
	(fsm-func  nil)
	(partition-free-images-p nil)
	(partition-free-innodb-p nil)
	(real-time-start 0)
	(real-time-stop  0))
    (put-timestamp-message-start message :put put)
    (debug-message file-name)
    ;; 1) give FSM the `start' input, store new `state', increment `updates'
    (setq input "start")
    (setq state-new (fsm-transition state-old input :put put))
    (sql-update-file-state file-name state-new :put nil)
    (setq state-old state-new)
    ;; 2) process file with appropriate function
    (setq fsm-func (fsm-function file-type state-new :put put))
    ;;    assert disk space for images
    (setq partition-free-images-p 
	  (if (member fsm-func *fsm-function-needs-partition-free-images*)
	      (assert-partition-free-images :put put)
	    t))
    ;;    assert disk space for database
    (setq partition-free-innodb-p 
	  (if (member fsm-func *fsm-function-needs-partition-free-innodb*)
	      (assert-partition-free-innodb :put put)
	    t))
    ;;    start clock, call function, stop clock
    (setq real-time-start (get-internal-real-time))               ; <-- time
    (if (and
	 partition-free-images-p
	 partition-free-innodb-p
	 (log-test fsm-func file-name :put put))                  ; <-- apply
	(setq input "done")
      (setq input "fail"))
    (setq real-time-stop  (get-internal-real-time))               ; <-- time
    (sql-insert-time fsm-func file-name (- real-time-stop real-time-start))
    ;; 3) give FSM the `done' or `fail' input, and store new state
    (setq state-new (fsm-transition state-old input :put put))
    (unless (string= state-old state-new)
      (sql-update-file-state file-name state-new :put put))
    (put-timestamp-message-done message :put put)
    ;; 4) we should routinely delete some rows from the `objectcache'
    (when (member fsm-func *fsm-function-needs-delete-objectcache*)
      (sql-delete-from-objectcache wiki :put put))
    ;; 5) flush HDD write cache to enhance Durability (the `D' in ACID)
    (hdd-write-cache-flush-all :put put)
  ))

(defun table-key-spec-scrape (database-name table-name &key (put nil))
  "Scraping specifications of keys for given table"
  ;;
  ;; Design note:
  ;;
  ;; Key specification list is scraped from `SHOW CREATE TABLE' and
  ;; looks like:
  ;;
  ;; ("UNIQUE KEY `cl_from` (`cl_from`,`cl_to`)"
  ;;  "KEY `cl_sortkey` (`cl_to`,`cl_type`,`cl_sortkey`,`cl_from`)"
  ;;  "KEY `cl_timestamp` (`cl_to`,`cl_timestamp`)"
  ;;  "KEY `cl_collation` (`cl_collation`)")
  ;;
  ;; or
  ;;
  ;; ("PRIMARY KEY (`page_id`)"
  ;;  "UNIQUE KEY `name_title` (`page_namespace`,`page_title`)"
  ;;  "KEY `page_random` (`page_random`)"
  ;;  "KEY `page_len` (`page_len`):
  ;;  "KEY `page_redirect_namespace_len` (`page_is_redirect`,`page_namespace`,`page_len`)")
  ;;
  ;; where
  ;;
  ;; PRIMARY KEY means check no duplicates and no NULLs for the key, and
  ;;                   use as clustered index; and
  ;; UNIQUE  KEY means check no duplicates for the key.
  ;;
  (put-message-value "table-key-spec-scrape" 
		     (format nil "~a.~a" database-name table-name) :put put)
  (let ((show-create-table (sql-show-create-table database-name table-name
						  :put put)))
    (when (null show-create-table)
      (put-message-value-fail-and-abort (_ "sql-show-create-table returned")
					show-create-table))
    (loop
     with lines = show-create-table
     for line in lines
     as dummy = (put-message line :put put)
     as line-trimmed = (string-trim '(#\Space #\,) line)
     when (or (regexp:match "^INDEX"         line-trimmed)
	      (regexp:match "^KEY"           line-trimmed)
	      (regexp:match "^UNIQUE INDEX"  line-trimmed)
	      (regexp:match "^UNIQUE KEY"    line-trimmed)
	      )
     collect line-trimmed)))

(defun fsm-table-add-index (database-table-name &key (put nil))
  "Adding secondary indices for given table"
  ;;
  ;; Design note:
  ;;
  ;; `database-table-name' is formatted like: `commonswiki.image'.
  ;;
  (put-message-value (_ "adding secondary keys") database-table-name :put put)
  (let* ((database-name (file-name-to-database-name database-table-name
						    :put put))
	 (table-name    (first
			 (last
			  (regexp:regexp-split (regexp:regexp-quote ".")
					       database-table-name))))
	 (keys-should   (table-key-spec-scrape *db-name*     table-name
					       :put put))
	 (dummy-0       (put-message keys-should :put put))
	 (keys-actual   (table-key-spec-scrape database-name table-name
					       :put put))
	 (dummy-1       (put-message keys-actual :put put))
	 (keys-needed   (set-difference keys-should keys-actual
					:test #'string=))
	 (dummy-2       (put-message keys-needed :put put))
	 (result        t))
    (when (not (null keys-needed))
      (sleep-until-zero #'sql-select-schema-count-innodb-trx "KEY" :put put)
      (sql-alter-table-add-key database-name table-name keys-needed :put put)
      (sleep-until-zero #'sql-select-schema-count-innodb-trx "KEY" :put put)
      (sleep 1)
      (setq keys-actual (table-key-spec-scrape database-name table-name
					       :put put))
      (setq result (not (set-difference keys-should keys-actual
					:test #'string=))))
    result))

(defun fsm-table-block-size (database-table-name &key (put nil))
  "Setting `ROW_FORMAT=COMPRESSED KEY_BLOCK_SIZE=4' for given table"
  ;;
  ;; Design note:
  ;;
  ;; `database-table-name' is formatted like: `commonswiki.image'.
  ;;
  (put-message-value (_ "altering row format") database-table-name :put put)
  (let* ((database-name  (file-name-to-database-name database-table-name
						     :put put))
	 (table-name     (first
			  (last
			   (regexp:regexp-split (regexp:regexp-quote ".")
						database-table-name))))
	 (table-key      (first
			  (member table-name
				  *mirror-innodb-table-key-block-size-list*
				  :test #'string= :key #'car)))
	 (key-block-size (second table-key))
	 (result         (null table-key))) ; t - table is not in list
    ;; if table is in the list, see if compressed
    (when (null result)
      (let* ((row-format-should "compressed")
	     (row-format-actual (sql-select-schema-tables-row-format 
				 database-name table-name :put put)))
	(setq result (string= (string-downcase row-format-should)
			      (string-downcase row-format-actual)))))
    ;; if table should be compressed, compress it
    (when (null result)
      (sleep-until-zero
       #'sql-select-schema-count-innodb-trx "COMPRESSED" :put put)
      (sql-alter-table-row-format database-name table-name
				  "COMPRESSED" key-block-size
				  :put put)
      (sleep-until-zero
       #'sql-select-schema-count-innodb-trx "COMPRESSED" :put put)
      ;; see if compressed successfully
      (let* ((row-format-should "compressed")
	     (row-format-actual (sql-select-schema-tables-row-format 
				 database-name table-name :put put)))
	(setq result (string= (string-downcase row-format-should)
			      (string-downcase row-format-actual)))))
    result))

(defun fsm-table-drop-index (database-table-name &key (put nil))
  "Dropping secondary indices for give table"
  ;;
  ;; Design note:
  ;;
  ;; `database-table-name' is formatted like: `commonswiki.image'.
  ;;
  ;; 1) We never drop a PRIMARY KEY (not listed in `table-key-spec-scrape');
  ;; 2) if more than one UNIQUE KEY, we drop all but the first; and
  ;; 3) drop all other KEYs.
  ;;
  (put-message-value (_ "dropping secondary keys") database-table-name :put put)
  (let* ((database-name (file-name-to-database-name database-table-name
						    :put put))
	 (table-name     (first
			  (last
			   (regexp:regexp-split (regexp:regexp-quote ".")
						database-table-name))))
	 (table-key      (first
			  (member table-name
				  *mirror-innodb-table-key-block-size-list*
				  :test #'string= :key #'car)))
	 ;; table-key = (table-name key-block-size key-drop-p key-keep-list)
	 (key-drop-p     (third  table-key))
	 (key-keep-list  (fourth table-key))
	 (keys-actual    (table-key-spec-scrape database-name table-name
						:put put))
	 (dummy          (put-message keys-actual :put put))
	 (keys-to-drop  nil)
	 (result        nil))
    ;; list keys to drop (DROP all but first PRIMARY KEY or UNIQUE KEY)
    (when key-drop-p
      (setq keys-to-drop
	(loop
	 for key-spec in keys-actual
	 as  dummy    = (put-message key-spec :put put)
	 as  key-name = (second (regexp:regexp-split "`" key-spec))
	 as  unique-p = (or (regexp:match "^UNIQUE INDEX"  key-spec)
			    (regexp:match "^UNIQUE KEY"    key-spec))
	 as  unique-n = (if unique-p 1 0) then (+ (if unique-p 1 0) unique-n)
	 when (or (null (member key-name key-keep-list :test #'string=))
		  (null unique-p)
		  (> unique-n 1))
	 collect key-name)))
    (put-message keys-actual :put put)
    (put-message keys-to-drop :put put)
    ;; drop keys (if any)
    (when (not (null keys-to-drop))
      (sleep-until-zero #'sql-select-schema-count-innodb-trx "KEY" :put put)
      (sql-alter-table-drop-key database-name table-name keys-to-drop :put put)
      (sleep-until-zero #'table-key-count database-name table-name :put put))
    ;; confirm no more than one key remaining (could be a UNIQUE KEY)
    (setq keys-actual (table-key-spec-scrape database-name table-name :put put))
    (put-message keys-actual :put put)
    (setq result (not (> (length keys-actual) 1)))
    (put-message result :put put)
    result))

(defun table-key-count (database-name table-name &key (put nil))
  "Counting KEYs; if no more than one KEY, return zero"
  (let ((key-count (length (table-key-spec-scrape database-name table-name
						  :put put))))
    (if (> key-count 1) 1 0)))

(defun fsm-transition (state input &key (put nil))
  "Changing file state according to *state-transition* table"
  (debug-message-value (_ "initial state and input")
		       (format nil "~a + ~a" state input))
  (unless (member state *state* :test #'string=)
    (put-message-value-fail-and-abort (_ "Error: FSM invalid state") state))
  (unless (member input *input* :test #'string=)
    (put-message-value-fail-and-abort (_ "Error: FSM invalid input") input))
  (dolist (transition *state-transition* nil)
    (when (and (string= state (first transition))
	       (string= input (second transition)))
      (progn
	(put-message-value (_ "state transition") 
			   (format nil "~a + ~a --> ~a" 
				   (first  transition)
				   (second transition)
				   (third  transition))
			   :put put)
	(return (third transition)))))) ; break loop


;;;;--------------------------------------------------------------------------+
;;;; Log utilities:                                                           |
;;;;   Note:  `put-message-*' functions should call `put-and-log-string'.     |
;;;;   Note:  Do not use `dribble', which is intended for logging interactive |
;;;;          sessions, and turns out to be non-portable.                     |
;;;;--------------------------------------------------------------------------+

		     
(defun log-start (&key (put nil))
  "Starting log"
  (put-message-value (_ "creating") *whereis-file-wpmirror-log* :put put)
  (defparameter *log-enabled-p* t)
  (put-timestamp-message-start "Starting log" :put put)
  t)

(defun log-stop (&key (put nil))
  "Stopping log"
  (put-message-value (_ "closing") *whereis-file-wpmirror-log* :put put)
  (put-timestamp-message-done "stopping log" :put put)
  (defparameter *log-enabled-p* nil)
  t)

(defun format-color-flag (flag)
  "Coloring text with ANSI Escape Sequences"
  (let ((clear    (format nil "~c[0m"  #\Escape))
	(up       (format nil "~c[1A"  #\Escape))
	(black    (format nil "~c[30m" #\Escape))
	(red      (format nil "~c[31m" #\Escape))
	(green    (format nil "~c[32m" #\Escape))
	(yellow   (format nil "~c[33m" #\Escape))
	(blue     (format nil "~c[34m" #\Escape))
	(magenta  (format nil "~c[35m" #\Escape))
	(cyan     (format nil "~c[36m" #\Escape))
	(white    (format nil "~c[37m" #\Escape)))
    (case flag
	  (:up    (format nil "~a" up))
	  (:fail  (format nil "[~afail~a]" red    clear))
	  (:info  (format nil "[~ainfo~a]" cyan   clear))
	  (:ok    (format nil "[~a ok ~a]" green  clear))
	  (:start (format nil "[~a....~a]" white  clear))
	  (:warn  (format nil "[~awarn~a]" yellow clear))
	  (otherwise nil)
	  )))

(defun put-flag-message (flag message &key (up nil))
  "Putting colored flag followed by message"
  (let* ((to-log    (concatenate 'string
				 (format-color-flag flag) 
				 message))
	 (to-term   (concatenate 'string
				(unless (null up) (format-color-flag :up))
				to-log)))
    (format *standard-output* "~a~%" to-term)
    (put-message to-log :put nil)))

(defun put-flag-message-2 (flag message &key (up nil))
  "Putting colored flag followed by message, and an extra line"
  (put-flag-message flag message :up up)
  (put-flag-message :done (_ "done") :up up))

(defun put-flag-message-value (flag message value &key (up nil))
  "Putting colored flag followed by message and value"
  (let* ((to-log    (concatenate 'string
				 (format-color-flag flag) 
				 message))
	 (to-term   (concatenate 'string
				(unless (null up) (format-color-flag :up))
				to-log)))
    (format *standard-output* "~34a: ~a~%" to-term value)
    (put-message-value to-log value :put nil)))

(defun log-test (f &rest args)
  "Wrapping evaluation of a boolean valued function with logging"
  (let* ((put        nil)
	 (doc        (_ (documentation f 'function)))
	 ;; use (cs-cl:symbol-name f) in modern case-sensitive world
	 (warn-p     (string= "warn" (cs-cl:symbol-name f) :end2 4))
	 (first-args (butlast args 2))
	 (message    (format nil "~a~{ ~a~}" f first-args)))
    (put-timestamp-message-start doc :put put)
    (put-flag-message :start message)
    (let ((res (apply f args)))                                 ; <-- apply 
      (if res
	  (progn
	    (put-timestamp-message-done doc :put put)
	    (put-flag-message :ok message :up t))
	(progn
	  (put-message (gethash f *error-messages*) :put put)
	  (put-timestamp-message-fail doc :put put)
	  (if (null warn-p)
	      (put-flag-message :fail message :up t)
	    (put-flag-message :warn message :up t))))
      res)))

(defun log-test-set (function-list &rest args)
  "Running tests and logging result"
  (let ((put      nil)
	(message  (_ "logging test set"))
	(all-pass t))
    (put-message-value function-list args :put put)
    (put-timestamp-message-start message :put put)
    (dolist (f function-list all-pass)
      (setq all-pass (and (apply #'log-test f args) all-pass))) ; <-- apply
    (if all-pass
	(put-timestamp-message-done message :put put)
      (put-timestamp-message-fail message :put put))
    all-pass))

(defun log-test-set-or-die (function-list &rest args)
  "Running tests, logging results, and die if any fail"
  (unless (apply #'log-test-set function-list args)
    (abort-and-die)))

(defun formatted-timestamp ()
  "Formatting decoded universal time as a human readable string"
  (multiple-value-bind (s m h dd mm yyyy dow dst tz)
      (get-decoded-time)
    (format nil "~4d-~2,'0d-~2,'0d ~2,'0d:~2,'0d:~2,'0d" yyyy mm dd h m s)))

(defun put-timestamp-message-start (message &key (put nil))
  "Logging timestamped message"
  (put-message-start (format nil "~a ~a" (formatted-timestamp) message)
		     :put put))

(defun put-timestamp-message-done (message &key (put nil))
  "Logging timestamped message done"
  (put-message-done (format nil "~a ~a" (formatted-timestamp) message)
		    :put put))

(defun put-timestamp-message-fail (message &key (put nil))
  "Logging timestamped message fail"
  (put-message-fail (format nil "~a ~a" (formatted-timestamp) message) 
		    :put put))

(defun put-timestamp-message-fail-and-abort (message &key (put nil))
  "Logging timestamped message fail and abort"
  (put-message-fail-and-abort 
   (format nil "~a ~a" (formatted-timestamp) message) :put put))

;;;;--------------------------------------------------------------------------+
;;;; Nomenclature                                                             |
;;;;--------------------------------------------------------------------------+


(defun database-name-to-database-dump-file-name (database-name &key (put nil))
  "Mapping database name to database dump file name"
  (if (string= database-name *db-name*)
      *whereis-file-mediawiki-farm-database*
    (format nil "~a.sql" database-name)))

(defun file-name-to-database-name (file-name &key (put nil))
  "Determining database name for given file-name"
  (let ((wiki  (sql-select-file-wiki file-name :put put)))
    (wiki-to-database-name wiki :put put)))

(defun file-name-to-date (file-name &key (put nil))
  "Determining date for given file-name"
  (sql-select-file-date file-name :put put))

(defun file-name-to-extension (file-name &key (put nil))
  "Determining file extension for given file-name"
  ;;
  ;; Design note:
  ;;
  ;; These are the extensions seen with dump files
  ;;
  (let* ((extension (first (last (regexp:regexp-split (regexp:regexp-quote ".")
						      file-name))))
	 (result    (cond ((string= "7z"   extension) :7z  )
		          ((string= "bz2"  extension) :bz2 )
			  ((string= "gz"   extension) :gz  )
			  ((string= "html" extension) :html)
			  ((string= "sql"  extension) :sql )
			  ((string= "txt"  extension) :txt )
			  ((string= "xml"  extension) :xml )
			  (t (put-message-value-fail-and-abort
			      (_ "unknown file extension") file-name)))))
    result))

(defun file-name-to-image-directory (file-name &key (put nil))
  "Determining where image files should go for given file-name"
  (let* ((project       (sql-select-file-project       file-name :put put))
	 (language-code (sql-select-file-language-code file-name :put put))
	 (path-images   (pathname-directory
			 *whereis-directory-mediawiki-images*))
	 (path-name     (make-pathname
			 :directory (append 
				     path-images
				     (list project language-code)))))
    path-name))

(defun file-name-to-index (file-name &key (put nil))
  "Computing number from the last two chars of `xxwiki-yyyymmdd-images-y-yz'"
  (let ((s (first    ; `yz' where {y,z in [0-9a-f]}
	    (last
	     (regexp:regexp-split "-" file-name)))))
    (parse-integer s :radix 16)))

(defun file-name-to-language-code (file-name &key (put nil))
  "Determining language-code for given file-name"
  (sql-select-file-language-code file-name :put put))

(defun file-name-to-page (file-name &key (put nil))
  "Determining beginning page number for given file-name"
  (sql-select-file-page file-name :put put))

(defun file-name-to-pages (file-name &key (put nil))
  "Determining pages count for given file-name"
  (sql-select-file-pages file-name :put put))

(defun file-name-to-path-name (file-name &key (put nil))
  "Generating path-name where given file may be found"
  (let* ((path-name  (merge-pathnames
		      (parse-namestring *whereis-directory-wpmirror-working*)
		      (parse-namestring file-name))))
    (put-message-value (_ "file-name-to-path") path-name :put put)
    path-name))

(defun file-name-to-project (file-name &key (put nil))
  "Determining project for given file-name"
  (sql-select-file-project file-name :put put))

(defun file-name-to-server (file-name &key (put nil))
  "Mapping [d/i/s/x]chunk name to server"
  (wiki-to-server (file-name-to-wiki file-name :put put) :put put))

(defun file-name-to-type (file-name &key (put nil))
  "Determining file-type for given file-name"
  (sql-select-file-type file-name :put put))

(defun file-name-to-url (file-name &key (put nil))
  "Determining URL of remote file"
  (put-message-start (_ "generating URL for file") :put put)
  (let* ((wiki (file-name-to-wiki file-name :put put))
	 (date (file-name-to-date file-name :put put))
	 (url  (cond ((or (regexp:match "incr"        file-name))
		      (format nil "~a~a/~a/~a" *wikimedia-site-xincr*
			      wiki date file-name))
                     ((or (regexp:match "md5sum"      file-name)
			  (regexp:match "xml"         file-name)
			  (regexp:match "sql"         file-name)
			  (regexp:match "titles"      file-name)
			  (regexp:match "multistream" file-name)
			  (regexp:match "dumpruninfo" file-name))
		      (format nil "~a~a/~a/~a" *wikimedia-site-xdump* 
			      wiki date file-name))
		     ((or (regexp:match "local-media"  file-name)
			  (regexp:match "remote-media" file-name))
		      (format nil "~a~a/~a/~a" *wikimedia-site-idump*
			      "fulls" date file-name))
		     (t (put-message-value-fail-and-abort
			 (_ "not xml, sql, media") file-name)))))
    (put-message url :put put)
    (put-message-value-done (_ "generating URL for file") file-name :put put)
    url))

(defun file-name-to-wiki (file-name &key (put nil))
  "Determining wiki for given file-name"
;;  "Mapping [d/i/s/x]chunk name to wiki"
;;  (first (regexp:regexp-split "-" file-name)))
  (sql-select-file-wiki file-name :put put))

(defun file-name-to-xchunk-name (file-name &key (put nil))
  "Identifying `xchunk' that generated `dchunk' or `schunk'"
  (let* ((wiki          (file-name-to-wiki          file-name :put put))
	 (type          (file-name-to-type          file-name :put put))
	 (join-string   (format nil "pages-~a"     (wikimedia-xdump-type-string
						    :put put)))
	 (temp          nil)
	 (result        nil))
    (when (member type (list "dchunk" "schunk") :test #'string=)
      (setq temp
	    (cond ((regexp:match
		    (format nil "~a-[0-9]*-page-p[0-9]*-c[0-9]*.sql"     wiki)
		    file-name)
		   (join (regexp:regexp-split "page"     file-name)
			 join-string))
		  ((regexp:match
		    (format nil "~a-[0-9]*-revision-p[0-9]*-c[0-9]*.sql" wiki)
		    file-name)
		   (join (regexp:regexp-split "revision" file-name)
			 join-string))
		  ((regexp:match
		    (format nil "~a-[0-9]*-text-p[0-9]*-c[0-9]*.sql"     wiki)
		    file-name)
		   (join (regexp:regexp-split "text"     file-name)
			 join-string))))
      (when temp
	(setq result
	      (cond ((string= type "dchunk")
		     (join (regexp:regexp-split "dat" temp) "xml"))
		    ((string= type "schunk")
		     (join (regexp:regexp-split "sql" temp) "xml"))))))
    result))

(defun language-code-normalized (language-code &key (put nil))
  "Replacing dashes with underscores"
  ;; replace `zh-classical' with `zh_classical'
  (substitute #\_ #\- (string-trim " " language-code)))

(defun language-code-to-database-name (language-code &key (put nil))
  "Mapping language code to database name"
  (if (string= language-code "template")
      *db-name*
    (format nil "~awiki" (language-code-normalized language-code :put put))))

(defun type-to-count (type &key (put nil))
  "Counting files of given type"
  (sql-select-type-count type :put put))

(defun type-to-progress (type &key (put nil))
  "Estimating progress in processing files of given type"
  (sql-select-type-progress type :put put))

(defun wiki-normalized (wiki &key (put nil))
  "Replacing dashes with underscores"
  ;; replace `zh-classicalwiki' with `zh_classicalwiki'
  (substitute #\_ #\- (string-trim " " wiki)))

(defun wiki-to-checksums-file-name (wiki date &key (put nil))
  "Generating file-name of checksums file for a given wiki"
  (put-message-start (_ "generating checksums file-name") :put put)
  (let* ((dummy-wiki    "xxwiki")
	 (dummy-date    "yyyymmdd")
	 (file-template (first
			 (last
			  (regexp:regexp-split
			   "/"
			   *wikimedia-path-checksums-template*))))
	 (file-name-1   (join (regexp:regexp-split 
			       dummy-wiki
			       file-template)
			      wiki))
	 (file-name-2   (join (regexp:regexp-split dummy-date file-name-1)
			      date)))
    (put-message-value wiki file-name-2 :put put)
    (put-message-done (_ "generating checksums file-name") :put put)
    file-name-2))

(defun wiki-to-checksums-path (wiki date &key (put nil))
  "Generating pathname of checksums file for a given language-code"
  (put-message-start (_ "generating checksums pathname"))
  (let* ((file-name  (wiki-to-checksums-file-name wiki date :put put))
	 (path-name  (merge-pathnames
		      (parse-namestring *whereis-directory-wpmirror-working*)
		      (parse-namestring file-name))))
    (put-message path-name :put put)
    (put-message-done (_ "generating checksums pathname") :put put)
    path-name))

(defun wiki-to-checksums-url (wiki date &key (put nil))
  "Generating URL of wikimedia checksums file for a given wiki"
  (let* ((message        (_ "generating URL for checksums file"))
	 (dummy-message  (put-message-start message :put put))
	 (dummy-wiki     "xxwiki")
	 (dummy-date     "yyyymmdd")
	 (path-1         (join (regexp:regexp-split
				dummy-wiki
				*wikimedia-path-checksums-template*)
			       wiki))
	 (path-2         (join (regexp:regexp-split
				dummy-date
				path-1)
			       date))
	 (url            (format nil "~a~a" *wikimedia-site-xdump* path-2)))
    (put-message url :put put)
    (put-message-value-done message wiki :put put)
    url))

(defun wiki-to-database-name (wiki &key (put nil))
  "Mapping wiki to database name"
  (if (string= wiki "template")
      *db-name*
    (wiki-normalized wiki :put put)))

(defun wiki-to-image-directory (wiki &key (put nil))
  "Determining directory to store images for given wiki"
  (let* ((path-images (pathname-directory *whereis-directory-mediawiki-images*))
	 (project       (wiki-to-project       wiki :put put))
	 (language-code (wiki-to-language-code wiki :put put))
	 (path-name     (make-pathname
			 :directory (append 
				     path-images
				     (list project language-code)))))
    path-name))

(defun wiki-to-idump-file-name-list (wiki &key (put nil))
  "Generating list of idump file names for a given wiki"
  (sql-select-idump-name-list wiki :put put))

(defun wiki-to-sdump-file-name (wiki &key (put nil))
  "Generating list of sdump file names for a given wiki"
  (sql-select-sdump-name wiki :put put))

(defun wiki-to-xdump-file-name (wiki &key (put nil))
  "Generating file-name of xdump file for a given wiki"
  (sql-select-xdump-name wiki :put put))

(defun wiki-to-language-code (wiki &key (put nil))
  "Mapping wiki to language-code"
  (let ((project (wiki-to-project wiki :put put)))
    (cond ((string= "wikipedia" project)
	   (first (regexp:regexp-split "wiki$" wiki)))
	  ((string= "wikibooks" project)
	   (first (regexp:regexp-split "wikibooks$" wiki)))
	  ((string= "wikimedia" project)
	   (first (regexp:regexp-split "wikimedia$" wiki)))
	  ((string= "wikinews" project)
	   (first (regexp:regexp-split "wikinews$" wiki)))
	  ((string= "wikiquote" project)
	   (first (regexp:regexp-split "wikiquote$" wiki)))
	  ((string= "wikisource" project)
	   (first (regexp:regexp-split "wikisource$" wiki)))
	  ((string= "wikiversity" project)
	   (first (regexp:regexp-split "wikiversity$" wiki)))
	  ((string= "wikivoyage" project)
	   (first (regexp:regexp-split "wikivoyage$" wiki)))
	  ((string= "wiktionary" project)
	   (first (regexp:regexp-split "wiktionary$" wiki)))
	  ((string= "template"  project) *db-name*)
	  (t (first (regexp:regexp-split project wiki))))))

(defun wiki-to-wikimedia-idump-url (wiki &key (put nil))
  "Locating URL of directory containing dated `idump's"
  ;; e.g. http://ftpmirror.your.org/wikimedia-imagedumps/tarballs/fulls/
  (format nil "~a~a/" *wikimedia-site-idump* "fulls"))

(defun wiki-to-wikimedia-idump-date-list (wiki &key (put nil))
  "Identifying dates of wikimedia `idump' directories"
  ;;
  ;; Design note:  
  ;;
  ;; `idump' mirrors might not offer a `latest' directory
  ;;
  ;; drwxr-xr-x           6 2013/03/25 20:25:54 .
  ;; drwxr-xr-x        1432 2012/06/01 06:19:37 20120430
  ;; drwxr-xr-x        1422 2012/11/18 17:00:08 20121003
  ;; drwxr-xr-x        1429 2012/11/27 07:05:02 20121104
  ;; drwxr-xr-x        1447 2012/12/09 04:38:18 20121201    <-- most recent
  ;;
  ;; Return ordered list of dates: ("20121201" "20121104" "20121003" "20120430")
  ;;
  (let* ((wiki-idump-url (wiki-to-wikimedia-idump-url wiki :put put))
	 (directory-list (download-directory-list wiki-idump-url :put put))
	 ;; filter for directories named for dates
	 (date-list (loop
		      for item in directory-list
		      when (regexp:match "^[0-9]*$" item)
		      collect item)))
    (put-message-value (format nil "idump-data-list for ~a" wiki)
		       date-list :put put)
    (sort date-list #'string>)))

(defun wiki-to-wikimedia-idump-most-recent-date (wiki &key (put nil))
  "Identifying date of latest `idump' files for given wiki"
  (let* ((date-list (wiki-to-wikimedia-idump-date-list wiki :put put)))
    (put-message date-list :put put)
    (first date-list)))

(defun wiki-to-wikimedia-xdump-url (wiki &key (put nil))
  "Locating URL of directory containing dated `xdump's for give wiki"
  ;; e.g. http://ftpmirror.your.org/wikimedia-dumps/simplewiki/
  (format nil "~a~a/" *wikimedia-site-xdump* wiki))

(defun wiki-to-wikimedia-xdump-date-list (wiki &key (put nil))
  "Identifying dates of wikimedia `xdump' directories for given wiki"
  ;;
  ;; Design note:
  ;;
  ;; Some `xdump' mirrors do not offer a `latest' directory
  ;;
  ;; drwxr-xr-x          36 2012/12/19 03:31:58 20121219
  ;; drwxr-xr-x          36 2012/12/30 04:02:39 20121230
  ;; drwxr-xr-x          36 2013/01/10 01:36:34 20130110    <-- most recent
  ;; drwxr-xr-x          63 2013/01/10 01:36:34 latest      <-- discard
  ;; drwxr-xr-x          63 2013/01/10 01:36:34 not         <-- discard
  ;;
  ;; Return ordered list of dates: ("20130110" "20121230" "20121219")
  ;;
  (let* ((wiki-xdump-url (wiki-to-wikimedia-xdump-url wiki :put put))
	 (directory-list (download-directory-list wiki-xdump-url :put put))
	 ;; filter for directories named for dates
	 (date-list (loop
		      for item in directory-list
		      when (regexp:match "^[0-9]*$" item)
		      collect item)))
    (put-message-value (format nil "xdump-date-list for ~a" wiki)
		       date-list :put put)
    (sort date-list #'string>)))

(defun wiki-to-wikimedia-xdump-most-recent-date (wiki &key (put nil))
  "Identifying date of latest `xdump' files for given wiki"
  (let* ((date-list (wiki-to-wikimedia-xdump-date-list wiki :put put)))
    (put-message date-list :put put)
    (first date-list)))

(defun wiki-to-wikimedia-xincr-url (wiki &key (put nil))
  "Locating URL of directory containing dated `xincr's for give wiki"
  ;; e.g. http://dumps.wikimedia.org/other/incr/simplewiki/
  (format nil "~a~a/" *wikimedia-site-xincr* wiki))

(defun wiki-to-wikimedia-xincr-date-list (wiki &key (put nil))
  "Identifying dates of wikimedia `xincr' directories for given wiki"
  ;;
  ;; Design note:
  ;;
  ;; Return ordered list of dates: ("20140803" "20140802" "20140801")
  ;;
  (let* ((wiki-xincr-url (wiki-to-wikimedia-xincr-url wiki :put put))
	 (directory-list (download-directory-list wiki-xincr-url :put put))
	 ;; filter for directories named for dates
	 (date-list (loop
		      for item in directory-list
		      when (regexp:match "^[0-9]*$" item)
		      collect item)))
    (put-message-value (format nil "xincr-date-list for ~a" wiki)
		       date-list :put put)
    (sort date-list #'string>)))

(defun wiki-to-wikimedia-xincr-most-recent-date (wiki &key (put nil))
  "Identifying date of latest `xincr' files for given wiki"
  (let* ((date-list (wiki-to-wikimedia-xincr-date-list wiki :put put)))
    (put-message date-list :put put)
    (first date-list)))

(defun wiki-to-project (wiki &key (put nil))
  "Mapping wiki to project"
  ;; ordered by number of wikis (desc) (as of 2012)
  (cond ((regexp:match "wiki$"        wiki) "wikipedia"  ) ; 322
	((regexp:match "wiktionary$"  wiki) "wiktionary" ) ; 217
        ((regexp:match "wikibooks$"   wiki) "wikibooks"  ) ; 123
	((regexp:match "wikiquote$"   wiki) "wikiquote"  ) ;  89
	((regexp:match "wikisource$"  wiki) "wikisource" ) ;  64
	((regexp:match "wikimedia$"   wiki) "wikimedia"  ) ;  33
	((regexp:match "wikinews$"    wiki) "wikinews"   ) ;  33
	((regexp:match "wikiversity$" wiki) "wikiversity") ;  15
	((regexp:match "wikivoyage$"  wiki) "wikivoyage" ) ;   9
	((regexp:match *db-name*      wiki) "template"   ) ;   1
	(t (put-message-value-fail-and-abort (_ "no project for wiki") wiki))))

(defun wiki-to-server (wiki &key (put nil))
  "Mapping wiki to server"
  (let ((language-code (wiki-to-language-code wiki :put put))
	(project       (wiki-to-project       wiki :put put))
	(match         (assoc wiki *wikimedia-server-alist* :test #'string=)))
    (if (not (null match))
	(cdr match)
      (format nil "~a.~a.site" language-code project))))

;;;;--------------------------------------------------------------------------+
;;;; Pattern recognition:  wiki, language-code, project                       |
;;;;--------------------------------------------------------------------------+


(defun all-p (arg &key (put nil))
  "Recognizing whether argument is `all'"
  (string= arg "all"))

(defun language-code-p (arg &key (put nil))
  "Recognizing whether argument is the name of a wiki"
  (member arg
	  (wikimedia-language-code-list :put put)
	  :test #'string=))

(defun project-p (arg &key (put nil))
  "Recognizing whether argument is the name of a wiki"
  (member arg
	  (wikimedia-project-list :put put)
	  :test #'string=))

(defun template-p (arg &key (put nil))
  "Recognizing whether argument is `template'"
  (string= arg "template"))

(defun wiki-p (arg &key (put nil))
  "Recognizing whether argument is the name of a wiki"
  (or
   (member arg 
	   (wikimedia-wiki-list :put put)
	   :test #'string=)
   (string= arg *db-name*)))

;;;;--------------------------------------------------------------------------+

(defun argument-to-mirror-wiki-list (arg &key (put nil))
  "Listing mirror wikis for given argument"
  (cond ((wiki-p                            arg :put put) (list arg))
        ((language-code-p                   arg :put put)
	 (language-code-to-mirror-wiki-list arg :put put))
        ((project-p                         arg :put put) 
	 (project-to-mirror-wiki-list       arg :put put))
	((template-p                        arg :put put) (list *db-name*))
        ((all-p                             arg :put put)
	 (mirror-wiki-list                      :put put))
	(t (put-message-value-fail-and-abort
	    (_ "Unknown wiki, language-code, project") arg))))

(defun argument-to-wikimedia-wiki-list (arg &key (put nil))
  "Listing WMF wikis for given argument"
  (cond	((wiki-p                               arg :put put) (list arg))
        ((language-code-p                      arg :put put)
	 (language-code-to-wikimedia-wiki-list arg :put put))
        ((project-p                            arg :put put) 
	 (project-to-wikimedia-wiki-list       arg :put put))
	;((template-p                           arg :put put) (list *db-name*))
        ((all-p                                arg :put put)
	 (wikimedia-wiki-list                      :put put))
	(t (put-message-value-fail-and-abort
	    (_ "Unknown wiki, language-code, project") arg))))

(defun language-code-to-mirror-wiki-list (language-code &key (put nil))
  "Listing mirror wikis for given language code"
  (loop 
   with wiki-list = (mirror-wiki-list :put put)
   for wiki in wiki-list
   when (string= (wiki-to-language-code wiki :put put) language-code)
     collect wiki))

(defun language-code-to-wikimedia-wiki-list (language-code &key (put nil))
  "Listing wikimedia wikis for given language code"
  (loop 
    with wiki-list = (wikimedia-wiki-list :put put)
    for wiki in wiki-list
    when (string= (wiki-to-language-code wiki :put put) language-code)
      collect wiki))

(defun mirror-commonswiki-p (&key (put nil))
  "Determining whether or not to mirror the entire commonswiki"
  (member *mirror-commons* *mirror-language-code-list*))

(defun mirror-wikidatawiki-p (&key (put nil))
  "Determining whether or not to mirror the entire wikidatawiki"
  (member *mirror-wikidata* *mirror-language-code-list*))

(defun mirror-image-download-p (&key (put nil))
  "Determining whether or not to download image files"
  *mirror-image-download-p*)

(defun mirror-database-list (&key (put nil))
  "Identifying mirror databases"
  (loop
   with database-name-list = (sql-show-databases :user *db-debian-user*
						 :put put)
   for database-name in database-name-list
   when (regexp:match "wik" database-name)
   collect database-name))

(defun mirror-language-code-list (&key (put nil))
  "Return a list of all language-codes known to the mirror"
  ;;
  ;; Design note:
  ;;
  ;; `special-list' (see below) includes `*mirror-commons*' regardless
  ;; of the value of `*mirror-image-download-p*'. This is because the
  ;; `commonswiki' database must exist, even if its tables are empty.
  ;; Otherwise `MediaWiki', if it cannot find `commonswiki', will
  ;; throw an error.
  ;;
  (let* ((special-list    (list *mirror-commons* *mirror-wikidata*))
	 (specified-list  (union *mirror-language-code-list*
				 special-list
				 :test #'string=)))
    (put-message-value "mirror-language-code-list" specified-list :put put)
    specified-list))

(defun mirror-project-list (&key (put nil))
  "Return a list of all projects known to the mirror"
  (union *mirror-project-list*
	 (when (assert-database-wpmirror-p :put put)
	   (sql-select-project-list :put put))
	 :test #'string=))

(defun mirror-wiki-list (&key (put nil))
  "Return a list of all wikis known to the mirror"
  (when (assert-database-wpmirror-p :put put)
    (sql-select-wiki-list :put put)))

(defun project-to-mirror-wiki-list (project &key (put nil))
  "Listing mirror wikis for given project"
  (loop
    with wiki-list = (mirror-wiki-list :put put)
    for wiki in wiki-list
    when (string= (wiki-to-project wiki :put put) project)
      collect wiki))

(defun project-to-wikimedia-wiki-list (project &key (put nil))
  "Listing WMF wikis for given project"
  (loop
    with wiki-list = (wikimedia-wiki-list :put put)
    for wiki in wiki-list
    when (string= (wiki-to-project wiki :put put) project)
      collect wiki))

(defun wikimedia-idump-list (wiki &key (put nil))
  "Listing of all WMF idumps (downloading on first call)"
  ;;
  ;; Design note:
  ;;
  ;; `idump' file names look like:
  ;; `simplewiki-20121201-local-media-1.tar' and
  ;; `simplewiki-20121201-remote-media-1.tar'.
  ;;
  ;; We scrape `idump' file names from the dump site's directory
  ;; listing.
  ;;
  (when (null *wikimedia-idump-list*)
    (let* ((idump-date     (wiki-to-wikimedia-idump-most-recent-date
			    wiki :put put))
	   (idump-url      (format nil "~a~a/~a/" *wikimedia-site-idump*
				   "fulls" idump-date))
	   (directory-list (download-directory-list idump-url :put put))
	   (idump-list-all (loop
			     for item in directory-list
			     when (regexp:match
				   (format nil
					   "^~a-~a-[a-z]*-media-[0-9]*.tar$"
					   wiki idump-date)
				   item)
			     collect item)))
      (defparameter *wikimedia-idump-list* (sort idump-list-all #'string<))))
  (put-message *wikimedia-idump-list* :put put)
  *wikimedia-idump-list*)

(defun wiki-to-idump-list (wiki &key (put nil))
  "Listing of all WMF idumps for given wiki"
  (let* ((idump-list-all (wikimedia-idump-list wiki :put put))
	 (wiki-template  (format nil "^~a-" wiki))
	 (idump-list     (loop
			   for idump-name in idump-list-all
			   when (regexp:match wiki-template idump-name)
			   collect idump-name)))
    (put-message idump-list :put put)
    idump-list))

(defun wikimedia-language-code-list (&key (put nil))
  "Listing all WMF language codes"
  *wikimedia-language-code-list*)

(defun wikimedia-project-list (&key (put nil))
  "Listing all WMF projects"
  (mapcar #'car *wikimedia-project-suffix-alist*))

(defun wikimedia-wiki-list (&key (put nil))
  "Listing of all WMF wikis (downloading on first call)"
  ;; scrape from `rsync-dirlist-last-1-good.txt' file (if exists)
  (when (null *wikimedia-wiki-list*)
    (let* ((directory-list (download-directory-list *wikimedia-site-xdump* 
						    :put put))
	   (wiki-list-all  (loop
			     for item in directory-list
			     when (and (regexp:match "wik" item)
				       (not (regexp:match "?"     item))
				       (not (regexp:match "css$" item))
				       (not (regexp:match "html$" item))
				       (not (regexp:match "mailto" item))
				       (not (regexp:match "tgz$"  item))
				       (not (regexp:match "edia$" item)))
			       collect item)))
      (defparameter *wikimedia-wiki-list* (sort wiki-list-all #'string<))))
  (put-message *wikimedia-wiki-list* :put put)
  *wikimedia-wiki-list*)


;;;;--------------------------------------------------------------------------+
;;;; Main modes:                                                              |
;;;;   --add     {<wiki>|<language-code>|<project>|all}                       |
;;;;   --delete  {<wiki>|<language-code>|<project>|all}                       |
;;;;   --drop    {<wiki>|<language-code>|<project>|all}                       |
;;;;   --dump    {<wiki>|<language-code>|<project>|all|template}              |
;;;;   --update  {<wiki>|<language-code>|<project>|all|template}              |
;;;;--------------------------------------------------------------------------+


(defun main-add (arg &key (put nil))
  "Add wikis for a given argument"
  ;; 2) Add mode
  (put-message (_ "-----add-mode-begin---------------------------") :put t)
  (let* ((arg-wiki-list    (argument-to-wikimedia-wiki-list arg :put put))
	 (mirror-wiki-list (mirror-wiki-list :put put))
	 (diff-wiki-list   (set-difference arg-wiki-list mirror-wiki-list
					   :test #'string=)))
    (defparameter *mirror-wiki-list* diff-wiki-list)
    (put-message-value (_ "main-add arg-wiki-list")      arg-wiki-list
		       :put put)
    (put-message-value (_ "main-add mirror-wiki-list")   mirror-wiki-list
		       :put put)
    (put-message-value (_ "main-add diff-wiki-list")     diff-wiki-list
		       :put put)
    (put-message-value (_ "main-add *mirror-wiki-list*") *mirror-wiki-list*
		       :put put)
    ;;(loop
    ;;  for wiki in *mirror-wiki-list*
    ;;  do (put-flag-message :info (format nil "~a" wiki)))
    (log-test-set '(fsm-boot) :put nil))
  (put-message (_ "-----add-mode-done----------------------------") :put nil))

(defun delete-directory-wp (path-name &key (put nil))
  "Delete directory"
  (when (ext:probe-pathname path-name)
    (shell-remove-directory path-name :put put)
    ;; may be terabytes, millions of files
    (sleep-while #'ext:probe-pathname path-name))
  ;; confirm the directory is gone
  (not (ext:probe-pathname path-name)))

(defun delete-directory-images (&key (put nil))
  "Delete all images, math, thumbs, and working files"
  (delete-directory-wp *whereis-directory-mediawiki-images*       :put put))

(defun delete-directory-working (&key (put nil))
  "Delete working directory"
  (delete-directory-wp *whereis-directory-wpmirror-working*       :put put))

(defun main-delete (arg &key (put nil))
  "Deleting files and state info, for a given argument"
  ;; 2) Delete mode
  (put-message (_ "-----delete-mode-begin------------------------") :put t)
  (loop
     with wiki-list = (argument-to-mirror-wiki-list arg :put put)
     for wiki in wiki-list
     do (delete-files-and-state-wiki wiki :put put))
  (put-message (_ "-----delete-mode-done-------------------------") :put nil))

(defun delete-files-and-state-wiki (wiki &key (put nil))
  "Deleting files and state info, for a given wiki"
  ;; 2) Delete mode
  (put-message-start (_ "deleting wiki") :put put)
  (log-test-set '(delete-state-for-wiki
		  delete-working-files-for-wiki)
		wiki :put put)
  (put-message-value-done (_ "deleting wiki") wiki :put put))

(defun delete-state-for-wiki (wiki &key (put nil))
  "Deleting state information for given wiki"
  (null (sql-delete-wiki wiki :put put)))

(defun delete-working-files-for-wiki (wiki &key (put nil))
  "Removing working files for given wiki"
  (shell-remove-all-working-files wiki :put put))

(defun drop-database-for-wiki-p (wiki &key (put nil))
  "Dropping database and confirming"
  (let ((database-name (wiki-to-database-name wiki :put put)))
    (drop-database-p database-name :put put)))

(defun create-database-p (database-name &key (put nil))
  "Creating database and confirming"
  (let ((message               (_ "creating database"))
	(result                nil)) ; t - database created
    (put-message-start message :put put)
    (when (not (assert-database-p database-name :put put))
      ;; wait until no other DATABASE transaction
      (sleep-until-zero
       #'sql-select-schema-count-innodb-trx "DATABASE" :put put)
      (sql-create-database database-name :put put)
      ;; wait until no other DATABASE transaction
      (sleep-until-zero
       #'sql-select-schema-count-innodb-trx "DATABASE" :put put))
    (setq result (assert-database-p database-name :put put))
    ;; confirm that the database exists
    (if result
	(put-message-value-done message database-name :put put)
      (put-message-value-fail message database-name))
    result))

(defun drop-database-p (database-name &key (put nil))
  "Dropping database and confirming"
  (let ((message               (_ "dropping database"))
	(message-no-database   (_ "database not found"))
	(result                nil)) ; t - database dropped
    (put-message-start message :put put)
    (if (assert-database-p database-name :put put)
	(progn
	  ;; wait until no other DATABASE transaction
	  (sleep-until-zero
	   #'sql-select-schema-count-innodb-trx "DATABASE" :put put)
	  (sql-drop-database database-name :put put)
	  ;; wait until no other DATABASE transaction
	  (sleep-until-zero #'database-count database-name :put put))
      (put-message-value message-no-database database-name :put put))
    ;; confirm that the database is gone
    (setq result (not (assert-database-p database-name :put put)))
    (if result
	(put-message-value-done message database-name :put put)
      (put-message-value-fail message database-name))
    result))

(defun database-count (database-name &key (put nil))
  "Counting instances of given database"
  (if (assert-database-p database-name :put put) 1 0))

(defun drop-wiki (wiki &key (put nil))
  "Dropping database, files, and state info, for a given wiki"
  ;; 2) Drop mode
  (put-message-start (_ "dropping wiki") :put put)
  (log-test-set '(;delete-interwiki-links
		  delete-state-for-wiki
		  drop-database-for-wiki-p
		  delete-working-files-for-wiki
		  ;delete-search-indices-for-wiki-p
		  )
		wiki :put put)
  (put-message-value-done (_ "dropping wiki") wiki :put put))

(defun main-drop (arg &key (put nil))
  "Dropping database, files, and state info, for a given language-code"
  ;; 2) Drop mode
  (put-message (_ "-----drop-mode-begin--------------------------") :put t)
  (loop
     with wiki-list = (argument-to-mirror-wiki-list arg :put put)
     for wiki in wiki-list
     do (drop-wiki wiki :put put))
  (put-message (_ "-----drop-mode-done---------------------------") :put nil))

(defun dump-database-p (database-name &key (put nil))
  "Dumping database and confirming"
  (let* ((message               (_ "dumping database"))
	 (message-no-database   (_ "database not found"))
	 (file-name             (database-name-to-database-dump-file-name
				 database-name :put put))
	 (path-name             (merge-pathnames
				 (parse-namestring
				  *whereis-directory-wpmirror-working*)
				 (parse-namestring file-name)))
	 (result                nil)) ; t - database dumped
    (put-message-start message :put put)
    (if (assert-database-p database-name :put put)
	(progn
	  (shell-mysqldump-to-file database-name path-name :put put)
	  ;; dumping can take time
	  (sleep-until #'assert-database-dump-p database-name :put put))
      (put-message-value message-no-database database-name :put put))
    (setq result (assert-database-dump-p database-name :put put))
    ;; confirm that the database is dumped
    (if result
	(put-message-value-done message database-name :put put)
      (put-message-value-fail message database-name))
    result))

(defun dump-database-for-wiki-p (wiki &key (put nil))
  "Dumping database and confirming"
  (let ((database-name (wiki-to-database-name wiki :put put)))
    (dump-database-p database-name :put put)))

(defun main-dump (arg &key (put nil))
  "Dump database to file `xxwiki.sql' in working directory for a given wiki"
  ;; 2) Dump mode
  (put-message (_ "-----dump-mode-begin--------------------------") :put t)
  (loop
     with wiki-list = (argument-to-mirror-wiki-list arg :put put)
     for wiki in wiki-list
     do (log-test-set '(dump-database-for-wiki-p)
		      wiki :put put))
  (put-message (_ "-----dump-mode-done---------------------------") :put nil))


;;;;--------------------------------------------------------------------------+
;;;; Main mode:  restore-default                                              |
;;;;--------------------------------------------------------------------------+


(defun main-restore (&key (put nil))
  "Dropping databases and files.  Starting over with default configuration"
  (put-message
      (_ "
+-----------------------------------------------------------------------------+
| WARNING  WARNING  WARNING   WARNING   WARNING   WARNING   WARNING   WARNING |
|                                                                             |
| This option may DELETE more than you expect or want:                        |
| 1)  Delete config files  : /etc/cron.d/wp-mirror                            |
|                          : /etc/mysql/conf.d/wp-mirror.cnf                  |
|                          : /etc/wp-mirror/default.conf                      |
|                          : /etc/wp-mirror/local.conf                        |
|                          : /etc/wp-mirror-mediawiki/LocalSettings.php       |
|                          : /etc/wp-mirror-media.../LocalSettings_account.php|
|                          : /etc/wp-mirror-medi.../LocalSettings_wpmirror.php|
|                          : /usr/share/wp-mirror-m.../ma.../database_farm.sql|
|                          : /usr/share/wp-mirror.../ma.../importDump_farm.sql|
|                          : /usr/share/wp-mirror-med.../ma.../update_farm.sql|
|                          : /var/lib/wp-mirror-mediawiki/favicon.ico         |
|                          : /var/lib/wp-mirror-mediawiki/wp-mirror.png       |
| 2)  Delete working files : /var/lib/wp-mirror-mediawiki/images/wp-mirror/   |
| 3)  Drop databases       : wikidb, wpmirror, *wik*                          |
|     Drop database users  : wikiadmin, wikiuser                              |
| The original default configuration is restored (mirror of `simple' wiki).   |
|                                                                             |
| WARNING  WARNING  WARNING   WARNING   WARNING   WARNING   WARNING   WARNING |
+-----------------------------------------------------------------------------+
") :put t)
  (when (yes-or-no-p "Do you wish to continue")
    (put-message (_ "-----restore-default-mode-begin---------------") :put t)
    ;; 1) drop databases: `wikidb', `xxwiki', and `wpmirror'
    (loop
     for database-name in (sql-show-databases-wpmirror :user *db-debian-user*
						       :put put)
     do (log-test-set '(drop-database-p) database-name :put put))
    ;; 2) drop database users: `wikiuser' and `wikiadmin'
    (log-test-set '(assert-dbms-drop-accounts-p)       :put put)
    ;; 3) delete image directory: `/var/lib/wp-mirror-mediawiki/images/'
    (log-test-set '(delete-directory-working) :put put)
    ;;    delete a few stray files
    (when (ext:probe-directory *whereis-directory-mediawiki-images*)
      (ext:cd *whereis-directory-mediawiki-images*)
      (shell-remove-file "*log"                                       :put put)
      (shell-remove-file "*sh"                                        :put put))
    ;; 4) delete all config files
    (loop
     for (dir-symbol file-symbol) in *wpmirror-config-restore-list*
     as dir-path     = (symbol-value dir-symbol)
     as file-name    = (symbol-value file-symbol)
     as dummy        = (put-message-value dir-path file-name :put put)
     as path-name    = (merge-pathnames (parse-namestring dir-path)
					(parse-namestring file-name))
     when (file-exists-p path-name :put put)
     do (put-flag-message-value :info (_ "deleting config file") path-name)
     and do (shell-remove-file path-name :put put)
     finally
       (shell-mysql-restart :put put)
       (put-flag-message :info (_ "done")))
    (put-message (_ "-----restore-default-mode-done----------------") :put nil)))


;;;;--------------------------------------------------------------------------+
;;;; Main mode:  profile                                                      |
;;;;--------------------------------------------------------------------------+


(defun gen-disk-usage-table (run-arg &key (put nil))
  "Generating performance summary for given run(s), return array"
  (if (null run-arg)
      (gen-disk-usage-table-many :put put)
    (gen-disk-usage-table-one run-arg :put put)))

(defun gen-disk-usage-table-many (&key (put nil))
  "Generating performance summary for given runs, return array"
  (let* ((run-max              (sql-select-time-run-max :put put))
	 (run-list             (sql-select-time-run-list
				*mirror-profiles-max* :put put))
	 (fun-list             (sql-select-time-disk-col-list :put put))
	 (fun-header           (_ "Disk usage [G]"))
	 (rows                 (+ 1 (* 2 (length fun-list))))
	 (cols                 (+ 2 (length run-list)))
	 (disk-array           (make-array (list rows cols))))
    ;; collect function column
    (dotimes (i rows)
      (if (eql i 0)
	  (setf (aref disk-array i 0) fun-header)
	(setf (aref disk-array i 0) (if (oddp i)
					(nth (floor (1- i) 2) fun-list)
				      (_ "ditto")))))
    (dotimes (i rows)
      (if (eql i 0)
	  (setf (aref disk-array i 1) (_ "val"))
	(setf (aref disk-array i 1) (if (zerop (rem (1- i) 2))
					(_ "min") (_ "max")))))
    ;; collect disk data
    (loop
      with run-data = nil
      for run in run-list
      for j from 2 to (1+ (length run-list))
      do
        (setq run-data (sql-select-time-disk-min-max-list run :put put))
	(push run run-data)
	(dotimes (i rows)
	  (setf (aref disk-array i j) (nth i run-data))))
    (put-message disk-array :put put)
    ;; round disk data to nearest [G]
    (dotimes (i rows)
      (dotimes (j cols)
	(when (and (> i 0) (> j 1))
	  (setf (aref disk-array i j)
		(round (aref disk-array i j) 1000000000)))))
    disk-array))

(defun gen-disk-usage-table-one (run-arg &key (put nil))
  "Generating performance summary for given run, return array"
  (let* ((run-max              run-arg)
	 (head-list            (list "[M]" "[G]" "[T]"))
	 (fun-list             (sql-select-time-disk-col-list :put put))
	 (fun-header           (format nil "Disk usage (run ~:d)" run-max))
	 (rows                 (+ 1 (* 2 (length fun-list))))
	 (cols                 (+ 2 (length head-list)))
	 (run-data             (sql-select-time-disk-min-max-list run-max
								  :put put))
	 (disk-array           (make-array (list rows cols))))
    ;; collect function column
    (dotimes (i rows)
      (if (eql i 0)
	  (setf (aref disk-array i 0) fun-header)
	(setf (aref disk-array i 0) (if (oddp i)
					(nth (floor (1- i) 2) fun-list)
				      (_ "ditto")))))
    (dotimes (i rows)
      (if (eql i 0)
	  (setf (aref disk-array i 1) (_ "val"))
	(setf (aref disk-array i 1) (if (zerop (rem (1- i) 2))
					(_ "min") (_ "max")))))
    ;; collect disk data for given run
    (push "[K]" run-data)
    ;; compute K, M, G, T
    (dotimes (i rows)
      (if (eql i 0)
	  (setf (aref disk-array i 2) "[M]")
	(setf (aref disk-array i 2) (round (nth i run-data) 1000000))))
    (dotimes (i rows)
      (if (eql i 0)
	  (setf (aref disk-array i 3) "[G]")
	(setf (aref disk-array i 3) (round (aref disk-array i 2) 1000))))
    (dotimes (i rows)
      (if (eql i 0)
	  (setf (aref disk-array i 4) "[T]")
	(setf (aref disk-array i 4) (round (aref disk-array i 3) 1000))))
    (put-message disk-array :put put)
    disk-array))

(defun gen-real-time-table (run-arg &key (put nil))
  "Generating performance summary for given run(s), return array"
  (if (null run-arg)
      (gen-real-time-table-many :put put)
    (gen-real-time-table-one run-arg :put put)))

(defun gen-real-time-table-many (&key (put nil))
  "Generating performance summary for given runs, return array"
  (let* ((run-max              (sql-select-time-run-max :put put))
	 (run-list             (sql-select-time-run-list
				*mirror-profiles-max* :put put))
	 (fun-list             (sql-select-time-fun-list    :put put))
	 (fun-header           (_ "Function"))
	 (rows                 (+ 1 (length fun-list)))
	 (cols                 (+ 1 (length run-list)))
	 (time-array           (make-array (list rows cols))))
    ;; collect function column
    (push fun-header fun-list)
    (dotimes (i rows)
      (setf (aref time-array i 0) (nth i fun-list)))
    ;; collect time data
    (loop
      with run-data  = nil
      with time-list = nil
      for run in run-list
      for j from 1 to (length run-list)
      do
        (setq run-data (sql-select-time-sum-list run :put put))
	(push (list fun-header run) run-data)
	(setq time-list
	      (mapcar #'(lambda (fun)
			  (let ((res (member fun run-data
					     :test #'string=
					     :key  #'car)))
			    (if (null res) 0 (cadar res))))
		      fun-list))
	(dotimes (i rows)
	  (setf (aref time-array i j) (nth i time-list))))
    (put-message time-array :put put)
    ;; round time data to nearest second
    (dotimes (i rows)
      (dotimes (j cols)
	(when (and (> i 0) (> j 0))
	  (setf (aref time-array i j)
		(round (aref time-array i j)
		       internal-time-units-per-second)))))
    time-array))

(defun gen-real-time-table-one (run-arg &key (put nil))
  "Generating performance summary for given run, return array"
  (let* ((run-max              run-arg)
	 (head-list            (list "[ms]" "[\%]" "[sec]" "[min]" "[hr]" "[d]"))
	 (fun-list             (sql-select-time-fun-list    :put put))
	 (fun-header           (format nil "Function (run ~:d)" run-max))
	 (rows                 (+ 1 (length fun-list)))
	 (cols                 (+ 1 (length head-list)))
	 (run-data             (sql-select-time-sum-list run-max :put put))
	 (run-sum              (reduce #'+ (mapcar #'second run-data)))
	 (time-list            nil)
	 (time-array           (make-array (list rows cols)))
	 (time-last            0)
	 (time-sum             0))
    ;; collect function column
    (push fun-header fun-list)
    (dotimes (i rows)
      (setf (aref time-array i 0) (nth i fun-list)))
    ;; collect time data for given run - fill in zeros where needed
    (push (list fun-header "[ms]") run-data)
    (setq time-list
	  (mapcar #'(lambda (fun)
		      (let ((res (member fun run-data
					 :test #'string=
					 :key  #'car)))
			(if (null res) 0 (cadar res))))
		  fun-list))
    (dotimes (i rows)
      (setf (aref time-array i 1) (nth i time-list)))
    ;; compute ms
    (dotimes (i rows)
      (if (eql i 0)
	  (setf (aref time-array i 1) "[ms]")
	(setf (aref time-array i 1) (round (* 1000 (aref time-array i 1))
					   internal-time-units-per-second))))
    ;; compute percent
    (setq time-last (aref time-array (- rows 1) 1))
    (if (zerop time-last)                           ;; if GRAND-TOTAL = 0
	(setq time-sum  (round (* 1000 run-sum)
			       internal-time-units-per-second))
      (setq time-sum time-last))
    (dotimes (i rows)
      (if (eql i 0)
	  (setf (aref time-array i 2) "[\%]")
	(setf (aref time-array i 2) (round (* 100 (aref time-array i 1))
					   time-sum))))
    ;; compute sec, min, hr, day
    (dotimes (i rows)
      (if (eql i 0)
	  (setf (aref time-array i 3) "[sec]")
	(setf (aref time-array i 3) (round (aref time-array i 1) 1000))))
    (dotimes (i rows)
      (if (eql i 0)
	  (setf (aref time-array i 4) "[min]")
	(setf (aref time-array i 4) (round (aref time-array i 3) 60))))
    (dotimes (i rows)
      (if (eql i 0)
	  (setf (aref time-array i 5) "[hr]")
	(setf (aref time-array i 5) (round (aref time-array i 3) 3600))))
    (dotimes (i rows)
      (if (eql i 0)
	  (setf (aref time-array i 6) "[d]")
	(setf (aref time-array i 6) (round (aref time-array i 3) 86400))))
    (put-message time-array :put put)
    time-array))

(defun put-real-time-table (time-array &key (put nil))
  "Putting real-time table"
  (let* ((cols                 (second (array-dimensions time-array)))
	 (rows                 (first  (array-dimensions time-array)))
	 (col-width-array      (make-array cols :initial-element 0))
	 (format-array         (make-array cols))
	 (rule-array           (make-array cols))
	 (text-array           (make-array (list rows cols)))
	 (text                 (make-array '(0) :element-type 'base-char
					   :fill-pointer 0 :adjustable t)))
    ;; convert time-array to text-array
    (dotimes (i rows)
      (dotimes (j cols)
	(let ((elem (aref time-array i j)))
	  (setf (aref text-array i j)
		(cond ((stringp elem) (format nil "~a"  elem))
		      ((numberp elem) (format nil "~:d" elem)))))))
    (put-message text-array :put put)
    ;; compute column widths
    (dotimes (i rows)
      (dotimes (j cols)
	(when (> (length (aref text-array i j)) (aref col-width-array j))
	  (setf (aref col-width-array j) (length (aref text-array i j))))))
    (put-message col-width-array :put put)
    ;; compute formats
    (dotimes (j cols)
      (setf (aref format-array j)
	    (if (zerop j)
		(concatenate 'string "| ~"
			     (format nil "~d" (aref col-width-array j))
			     "a |")
	      (concatenate 'string " ~"
			   (format nil "~d" (aref col-width-array j))
			   "@a |")))
      (setf (aref rule-array j)
	    (if (zerop j)
		(format nil "+-~a-+" (make-string (aref col-width-array j)
						  :initial-element #\-))
	      (format nil "-~a-+" (make-string (aref col-width-array j)
					       :initial-element #\-)))))
    (put-message format-array :put put)
    (put-message rule-array :put put)
    ;; put array
    (with-output-to-string (s text)
      (dotimes (i rows)
	(when (member i '(0 1))
	  (dotimes (j cols) (format s (aref rule-array j)))
	  (format s "~%"))
	(dotimes (j cols)
	  (format s (aref format-array j) (aref text-array i j)))
	(format s "~%"))
      (dotimes (j cols) (format s (aref rule-array j))))
    (put-message text :put t)))

(defun main-profile (run-arg &key (put nil))
  "Putting summary of real-time v. function for given run"
  (put-message (_ "-----profile-mode-begin-----------------------") :put t)
  (if (string= run-arg "0")
      (sql-truncate-table-time :put put)
    (progn
      (put-real-time-table (gen-real-time-table  run-arg :put put) :put put)
      (put-real-time-table (gen-disk-usage-table run-arg :put put) :put put)
      ))
  (put-message (_ "-----profile-mode-done------------------------") :put nil))


;;;;--------------------------------------------------------------------------+
;;;; Main mode:  update                                                       |
;;;;--------------------------------------------------------------------------+


(defun create-and-update-search-indices-for-wiki-p (wiki &key (put nil))
  "Creating and updating search indices for given wiki"
  (shell-mediawiki-cirrussearch-updatesearchindexconfig    wiki :put put)
  (shell-elasticsearch-indices-for-wiki                    wiki :put put))

(defun delete-search-indices-for-wiki-p (wiki &key (put nil))
  "Deleting search indices for given wiki"
  (shell-elasticsearch-delete-for-wiki                     wiki :put put)
  (not (shell-elasticsearch-indices-for-wiki               wiki :put put)))

(defun populate-search-indices-for-wiki-p (wiki &key (put nil))
  "Populating search indices for given wiki"
  (shell-mediawiki-cirrussearch-forcesearchindex-skiplinks wiki :put t)
  (quit)
  (shell-mediawiki-cirrussearch-forcesearchindex-skipparse wiki :put t)
  (shell-elasticsearch-indices-for-wiki                    wiki :put put))

(defun update-mediawiki-localization-p (&key (put nil))
  "Updating localization of messages for MediaWiki"
  (let* ((message-update-localization (_ "updating localization"))
	 (result                      nil))
    (put-message-start message-update-localization :put put)
    (shell-mediawiki-localization-update :put put)
    ;; updating can take time
    (sleep 2)
    ;; confirm lots of files under `/var/lib/wp-mirror-mediawiki/cache/'
    (setq result
	  (> (shell-count-dir *whereis-directory-mediawiki-cache* :put put)
	     100))
    (if result
	(put-message-done message-update-localization :put put)
      (put-message-fail message-update-localization))
    result))

(defun rebuild-titlekey-for-wiki-p (wiki &key (put nil))
  "Rebuilding title keys (search box suggestions) for given wiki"
  (let* ((database-name              (wiki-to-database-name wiki :put put))
	 (table-name-0               "page")
	 (long-name-0                (format nil "~a.~a"
					     database-name table-name-0))
	 (table-name-1               "titlekey")
	 (long-name-1                (format nil "~a.~a"
					     database-name table-name-1))
	 (message-rebuild-titlekey   (_ "rebuilding titlekey"))
	 (message-no-database-table  (_ "database table not found"))
	 (table-0-exist-p            (assert-database-table-p
				      database-name table-name-0 :put put))
	 (table-1-exist-p            (assert-database-table-p
				      database-name table-name-1 :put put))
	 (tk-page-id-max             0)
	 (result                     nil))
    (put-message-start message-rebuild-titlekey :put put)
    ;; 1) select max(tk_page) from `titlekey' table
    (setq tk-page-id-max (sql-select-max-wiki-titlekey wiki :put put))
    ;; 2) update `titlekey'
    (if (and table-0-exist-p table-1-exist-p)
	(progn
	  (shell-mediawiki-rebuild-titlekey wiki :page-id-start tk-page-id-max
					    :put put)
	  ;; updating can take time
	  (sleep 2))
      (put-message-value message-no-database-table database-name :put put))
    (setq result (> (sql-select-count-wiki-titlekey wiki :put put) 0))
    ;; 3) confirm that the `titlekey' table is updated
    (if result
	(put-message-value-done message-rebuild-titlekey long-name-1 :put put)
      (put-message-value-fail message-rebuild-titlekey long-name-1))
    result))

(defun update-database-for-wiki-p (wiki &key (put nil))
  "Updating database for given wiki, and confirming"
  (let* ((database-name           (wiki-to-database-name wiki :put put))
	 (message-no-database     (_ "database not found"))
	 (result                  nil)) ; t - database updated
    (if (assert-database-p database-name :put put)
	(progn
	  (shell-mediawiki-farm-update wiki :put put)
	  ;; updating can take time
	  (sleep 2))
      (put-message-value message-no-database database-name :put put))
    (setq result (assert-database-p database-name :put put))
    ;; confirm that the database is updated
    result))

(defun main-update (arg &key (put nil))
  "Update database, to latest MediaWiki schema, for a given language"
  (put-message (_ "-----update-mode-begin------------------------") :put t)
  (loop 
     with wiki-list = (argument-to-mirror-wiki-list arg :put put)
     for wiki in wiki-list
     as  database-name = (wiki-to-database-name wiki :put put)
     do (put-flag-message-value :info (_ "updating database") database-name)
        (update-database-for-wiki-p wiki :put put))
  (put-message (_ "-----update-mode-done-------------------------") :put nil))


;;;;--------------------------------------------------------------------------+
;;;; Mirror mode:                                                             |
;;;;   0) Initialize parameters (command line, configuration file)            |
;;;;   1) Assert prerequisites                                                |
;;;;   2) Run in mirror mode                                                  |
;;;;   2.1) download checksum, xdump, sdump files, validate, and decompress   |
;;;;   2.2) split xdump into x-chunks                                         |
;;;;   2.3) convert x-chunks into s-chunks                                    |
;;;;   2.4) load s-chunks                                                     |
;;;;   2.5) downloaded idumps, extract                                        |
;;;;   2.6) generate i-chunks                                                 |
;;;;   2.7) run i-chunks (download missing images)                            |
;;;;   2.8) chown image directories                                           |
;;;;--------------------------------------------------------------------------+


(defun join (list-of-strings join-string)
  "Joining strings"
  (let ((n (length list-of-strings)))
    (cond ((eql n 0) '())
	  ((eql n 1) (first list-of-strings))
	  ((eql n 2) (concatenate 'string
				  (first list-of-strings)
				  join-string
				  (second list-of-strings)))
	  (t (concatenate 'string
			  (first list-of-strings)
			  join-string
			  (second list-of-strings)
			  join-string
			  (join (cddr list-of-strings) join-string))))))

(defun wait-for-internet-access (file-name &key (put nil))
  "Waiting for internet access, if processing the file involves a download"
  ;; We assume lock has been grabbed
  (let* ((message (_ "wait for internet access, if download required"))
	 (file-type (sql-select-file-type  file-name :put put))
	 (state-old (sql-select-file-state file-name :put put))
	 (input     "start")
	 (state-new (fsm-transition state-old input     :put put))
	 (fsm-func  (fsm-function   file-type state-new :put put)))
    ;; 0) when a download is required, wait for internet access.
    ;;    sometimes your Internet Service Provider (ISP) will go down
    ;;    for a few hours during the night
    (when (member fsm-func *fsm-function-needs-internet-access*)
      (put-message message)
      ;; actually this loop will not detect a failure, if your traffic
      ;; is going through a caching web proxy, and the failure lies
      ;; between the proxy and WMF
      (sleep-until #'assert-internet-access-to-wikimedia-site-p :put put))))

(defun main-mirror (&key (put t))
  "Purpose: Main function when wp-mirror is in Mirror Mode."
  ;; 2) Mirror mode
  (put-message (_ "-----mirror-mode-begin------------------------") :put t)
  ;; load initial record into finite-state-machine
  (when (eql *main-mode* :first-mirror)
    (let* ((real-time-start 0)
	   (real-time-stop  0))
      (setq real-time-start (get-internal-real-time))
      (log-test-set '(fsm-boot
		      release-all-file-semaphores) :put put)
      (setq real-time-stop  (get-internal-real-time))
    ;; Start new run (time trial)
    (defparameter *db-wpmirror-profile*
      (+ 1 (sql-select-time-run-max :put put)))
    (sql-insert-time "fsm-boot" nil (- real-time-stop real-time-start) 
		     :put put)))
  (loop named mirror-pass-multiple
    for i from 0 to 1
    ;; first pass does all the work
    ;; second pass retries any failed `xchunks' and `ichunks'
    while (first-mirror-exists-p :put put) ; all mirrors exit if the first exits
    do
    (when (and (zerop i) (eql *main-mode* :first-mirror))
      (sql-update-fail-to-start :put put))   ; reset failed `xchunk'
    (loop named mirror-pass-single
      ;;   2a) decide order in which files should be processed,
      ;;       select one, and grab its lock (set its semaphore to 0)
      for file-name of-type string = (sql-select-next-file :put put) 
      ;;       all mirrors exit if the first has
      ;;       exit if no file selected (done)
      while (and (first-mirror-exists-p :put put)
		 file-name)
        do
          ;; 2b) wait if necessary
          (wait-for-internet-access file-name :put put)
	  ;; 2c) process the file
	  (put-message-value (_ "file before") 
	  		     (sql-select-file file-name :put put) :put put)
	  (fsm-process-file file-name :put put) ; <--- heavy lifting
	  ;; 2d) release its lock (set semaphore to 1)
	  (sql-update-file-semaphore file-name 1 :put put)
	  (put-message-value (_ "file after") 
	  		       (sql-select-file file-name :put put) :put put)
	  (put-message "----------" :put put)
	  ;;(die) ; uncomment to `single-step' for debug purposes
	  )
    (when (and (zerop i) (eql *main-mode* :first-mirror))
      (put-flag-message :info (_ "retry failed xchunks using importDump.php"))
      (setq *mirror-process-xml* :import)   ; fallback for failed `xchunk's
      (sql-update-fail-to-valid :put put))) ; reset failed chunks
  (put-message (_ "-----mirror-mode-done-------------------------") :put put))


;;;;--------------------------------------------------------------------------+
;;;; Monitor mode:                                                            |
;;;;   0) Initialize parameters (command line, configuration file)            |
;;;;   1) Assert prerequisites                                                |
;;;;   2) Determine monitor mode (:auto, :gui, :screen, :text)                |
;;;;--------------------------------------------------------------------------+


(defvar       *report*                  nil)

(defstruct report
  ;; timestamp
  timestamp
  ;; type
  database-count
  database-progress
  table-count
  table-progress
  checksum-count
  checksum-progress
  xdump-count
  xdump-progress
  xml-count
  xml-progress
  xchunk-count
  xchunk-progress
  sdump-count
  sdump-progress
  sql-count
  sql-progress
  schunk-count
  schunk-progress
  dchunk-count
  dchunk-progress
  idump-count
  idump-progress
  ichunk-count
  ichunk-progress
  images-count
  images-progress
  ;; InnoDB
  innodb-buffer-pool-pages-total
  innodb-buffer-pool-pages-dirty
  innodb-buffer-pool-pages-dirty-progress
  innodb-buffer-pool-pages-insert
  innodb-buffer-pool-pages-insert-progress
  ;; System
  partition-images-free
  partition-images-size
  partition-images-free-to-size-ratio
  partition-innodb-free
  partition-innodb-size
  partition-innodb-free-to-size-ratio
)

(defun monitor-data-collect (&key (put nil))
  "Collecting status data suitable for monitors"
  (put-message-start (_ "collecting status data for monitor") :put put)
  (let* ((innodb-buffer-pool-pages-dirty 
	  (sql-show-innodb-buffer-pool-pages-dirty    :put put))
	 (innodb-buffer-pool-pages-insert
	  (sql-show-innodb-buffer-pool-pages-insert   :put put))
	 (innodb-buffer-pool-pages-total
	  (sql-show-innodb-buffer-pool-pages-total    :put put))
	 ;; System
	 (partition-images-free
	  (system-partition-free-images               :put put))
	 (partition-images-size
	  (system-partition-size-images               :put put))
	 (partition-innodb-free
	  (system-partition-free-innodb               :put put))
	 (partition-innodb-size
	  (system-partition-size-innodb               :put put)))
    (put-message-value (_ "innodb-buffer-pool-pages-dirty") 
		       innodb-buffer-pool-pages-dirty               :put put)
    (put-message-value (_ "innodb-buffer-pool-pages-insert") 
		       innodb-buffer-pool-pages-insert              :put put)
    (put-message-value (_ "innodb-buffer-pool-pages-total") 
		       innodb-buffer-pool-pages-total               :put put)
    (setq *report*
	(make-report
	 ;; timestamp
	 :timestamp	          (formatted-timestamp)
	 ;; type
	 :database-count          (type-to-count    "database" :put put)
	 :database-progress       (type-to-progress "database" :put put)
	 :table-count             (type-to-count    "table"    :put put)
	 :table-progress          (type-to-progress "table"    :put put)
	 :checksum-count          (type-to-count    "checksum" :put put)
	 :checksum-progress       (type-to-progress "checksum" :put put)
	 :xdump-count             (type-to-count    "xdump"    :put put)
	 :xdump-progress          (type-to-progress "xdump"    :put put)
	 :xml-count               (type-to-count    "xml"      :put put)
	 :xml-progress            (type-to-progress "xml"      :put put)
	 :xchunk-count            (type-to-count    "xchunk"   :put put)
	 :xchunk-progress         (type-to-progress "xchunk"   :put put)
	 :sdump-count             (type-to-count    "sdump"    :put put)
	 :sdump-progress          (type-to-progress "sdump"    :put put)
	 :sql-count               (type-to-count    "sql"      :put put)
	 :sql-progress            (type-to-progress "sql"      :put put)
	 :schunk-count            (type-to-count    "schunk"   :put put)
	 :schunk-progress         (type-to-progress "schunk"   :put put)
	 :dchunk-count            (type-to-count    "dchunk"   :put put)
	 :dchunk-progress         (type-to-progress "dchunk"   :put put)
	 :idump-count             (type-to-count    "idump"    :put put)
	 :idump-progress          (type-to-progress "idump"    :put put)
	 :ichunk-count            (type-to-count    "ichunk"   :put put)
	 :ichunk-progress         (type-to-progress "ichunk"   :put put)
	 :images-count            (type-to-count    "images"   :put put)
	 :images-progress         (type-to-progress "images"   :put put)
	 ;; InnoDB
	 :innodb-buffer-pool-pages-total innodb-buffer-pool-pages-total
	 :innodb-buffer-pool-pages-dirty innodb-buffer-pool-pages-dirty
	 :innodb-buffer-pool-pages-dirty-progress
	 (if (zerop innodb-buffer-pool-pages-total)
	     0
	   (float (/ innodb-buffer-pool-pages-dirty
		     innodb-buffer-pool-pages-total)))
	 :innodb-buffer-pool-pages-insert innodb-buffer-pool-pages-insert
	 :innodb-buffer-pool-pages-insert-progress 
	 (if (zerop innodb-buffer-pool-pages-total)
	     0
	   (float (/ innodb-buffer-pool-pages-insert 
		     innodb-buffer-pool-pages-total)))
	 ;; System
	 :partition-images-free    partition-images-free
	 :partition-images-size    partition-images-size
	 :partition-images-free-to-size-ratio
	 (if (zerop partition-images-size)
	     0
	   (float (/ partition-images-free
		     partition-images-size)))
	 :partition-innodb-free    partition-innodb-free
	 :partition-innodb-size    partition-innodb-size
	 :partition-innodb-free-to-size-ratio
	 (if (zerop partition-innodb-size)
	     0
	   (float (/ partition-innodb-free
		     partition-innodb-size)))
       ))))

(defun windowing-system-running-p (&key (put nil))
  "Determining if a windowing system is running"
  (put-message-start (_ "probing running windowing system") :put put)
  (let ((windowing-system nil))
    (with-open-stream (s (ext:run-shell-command
			  (format nil "ps -wef | ~a ~a"
				  *whereis-grep* *whereis-x*)
			  :output :stream))
      (setq windowing-system (read-line s nil nil)))
    (if (null windowing-system)
	(put-message-fail (_ "probing running windowing system"))
      (put-message-value-done (_ "probing running windowing system")
			      windowing-system :put put))
    windowing-system))

(defun monitor-mode-gui-screen-or-text (&key (put nil))
  "Determining best monitor mode (gui, screen, or text)"
  (put-message-start (_ "choosing monitor mode") :put put)
  (put-message-value (_ "monitor mode") *monitor-mode* :put put)
  (when (eql *monitor-mode* :auto)
    (put-message-value (_ "probing for :gui") *monitor-mode* :put put)
    (if (and (member :clx *features*)
	     (windowing-system-running-p))
	(setq *monitor-mode* :gui)
      (progn
	(put-message-value (_ "probing for :screen") *monitor-mode* :put put)
	(if (member :screen *features*)
	    (setq *monitor-mode* :screen)
	  (progn
	    (put-message-value (_ "falling back on :text") *monitor-mode*
			       :put put)
	    (setq *monitor-mode* :text))))))
  (put-message-value-done (_ "choosing monitor mode") *monitor-mode* :put put)
  *monitor-mode*)

(defun monitor-mode-gui (&key (put nil))
  "Running the monitor in gui mode"
  (put-message-start (_ "attempting gui mode") :put put)
  (let* ((host               '())
	 (display            (xlib:open-display       host))
	 (screen             (first (xlib:display-roots display)))
	 (black              (xlib:screen-black-pixel screen))
	 (white              (xlib:screen-white-pixel screen))
	 (root-window        (xlib:screen-root        screen))
	 ;; take the most preferred font available
	 (favorite-font-available
	              (first
		       (reduce #'append
			       (mapcar #'(lambda (x) (xlib:list-font-names
						      display x))
				       *monitor-gui-font-preference-list*))))
	 (font        (xlib:open-font display  favorite-font-available))
	 (width       (* (+ 1 10 7 26 4 2)                        ; a b c d e
			 (xlib:max-char-width font)))
	 (height      (* (+ 20 1)                                 ; lines 
			 (floor (* 1.4 (xlib:font-ascent font))))); line spacing
	 ;; X11 colors (see `/etc/X11/rgb.txt')
	 (gcontexts   (make-hash-table :test 'equal))
	 (gtext       (xlib:alloc-color
		       (xlib:window-colormap root-window) "black"))
	 (gback       (xlib:alloc-color
		       (xlib:window-colormap root-window) "LightYellow"))
	 (gfill       (xlib:alloc-color
		       (xlib:window-colormap root-window) "RoyalBlue"))
	 (gedge       (xlib:alloc-color
		       (xlib:window-colormap root-window) "YellowGreen"))
	 (net_wm_name      (xlib:intern-atom display "_NET_WM_NAME"))
	 (net_wm_icon_name (xlib:intern-atom display "_NET_WM_ICON_NAME"))
	 (window      (create-window-for-gui root-window width height gback))
	 (time-out    *monitor-poll-sec*))
    (setf (gethash 'text  gcontexts)
	  (xlib:create-gcontext
	   :drawable      root-window
	   :font          font
	   :background    gback
	   :foreground    gtext))
    (setf (gethash 'fill gcontexts)
	  (xlib:create-gcontext
	   :drawable      root-window
	   :background    gback
	   :foreground    gfill))
    (setf (gethash 'edge  gcontexts)
	  (xlib:create-gcontext
	   :drawable      root-window
	   :background    gback
	   :foreground    gedge))
    (unwind-protect
	(loop named gui       ; user terminates with button-press (see below)
	  ;; map (display) window
	  do
	    (monitor-data-collect :put put)
	    (debug-message-start "event-case")
	    (xlib:map-window window)
	    (xlib:event-case (display :discard-p      t
				      :force-output-p t
				      :timeout        time-out)
			     (:button-press () nil)
			     (:destroy-window ()              ; <termination>
					      (return-from gui t) t)
			     (:exposure (count)
					(when (zerop count)
					  (monitor-mode-gui-show window
								 gcontexts))
					nil)
			     (:key-press ()                   ; <termination>
					 (return-from gui t) t)
			     )
	    (xlib:send-event window :exposure nil)
	    (debug-message-value "event-case" (formatted-timestamp))))
    (put-message-start (_ "cleanup"))
    (xlib:display-finish-output display)
    (xlib:destroy-window window)
    (loop
       for g being each hash-value of gcontexts
       do (xlib:free-gcontext g))
    (loop
       while (xlib:discard-current-event display))
    (put-message-done (_ "cleanup"))
    (xlib:close-display display)
    (put-message-done  (_ "attempting gui mode"))))

(defun create-window-for-gui (root-window width height gback)
  "Create window"
  (let ((wind  (xlib:create-window
		:parent        root-window
		:x             0
		:y             0
		:width         width
		:height        height
		:background    gback
		:event-mask    (xlib:make-event-mask 
				:button-press
				:exposure
				:key-press
				:structure-notify))))
    (xlib:change-property wind
			  :wm_name   "WP-MIRROR - Monitor Mode"
			  :string    8
			  :transform #'char-code)
    (xlib:change-property wind
			  :_net_wm_name   "WP-MIRROR - Monitor Mode"
			  :string    8
			  :transform #'char-code)
    (xlib:change-property wind
			  :wm_icon_name   "wp-mirror"
			  :string    8
			  :transform #'char-code)
    (xlib:change-property wind
			  :_net_wm_icon_name   "wp-mirror"
			  :string    8
			  :transform #'char-code)
    wind))

(defun monitor-mode-gui-show (my-window gcontexts &key (put nil))
  "Showing status in gui format"
  (let* ((w         my-window)
	 (ww        (xlib:drawable-width   w))
	 (wh        (xlib:drawable-height  w))
	 (wr        (xlib:drawable-root    w))
	 (g         gcontexts)
	 (gt        (gethash 'text  g))
	 (f         (xlib:gcontext-font   gt))
	 (fa        (xlib:font-ascent      f))
	 (line      0))
    ;; clear window first (lest new stuff get written on top of old stuff)
    (xlib:clear-area w)
    ;; timestamp
    (let* ((str (report-timestamp *report*))
	   (x   (- ww (xlib:text-extents f str)))
	   (y   (* 1 fa)))
      (xlib:draw-glyphs w gt x y str))

    ;; xdump file
    (monitor-mode-gui-show-line w g (incf line)
      :a "Process:")

    (monitor-mode-gui-show-line w g (incf line)
      :b "database"
      :c (format nil "~10:d" (report-database-count *report*))
      :d (report-database-progress *report*))

    (monitor-mode-gui-show-line w g (incf line)
      :b "table"
      :c (format nil "~10:d" (report-table-count *report*))
      :d (report-table-progress *report*))

    (monitor-mode-gui-show-line w g (incf line)
      :b "checksum"
      :c (format nil "~10:d" (report-checksum-count *report*))
      :d (report-checksum-progress *report*))

    (monitor-mode-gui-show-line w g (incf line)
      :b "xdump"
      :c (format nil "~10:d" (report-xdump-count *report*))
      :d (report-xdump-progress *report*))

    (monitor-mode-gui-show-line w g (incf line)
      :b "xml"
      :c (format nil "~10:d" (report-xml-count *report*))
      :d (report-xml-progress *report*))

    (monitor-mode-gui-show-line w g (incf line)
      :b "xchunk"
      :c (format nil "~10:d" (report-xchunk-count *report*))
      :d (report-xchunk-progress *report*))

    (monitor-mode-gui-show-line w g (incf line)
      :b "sdump"
      :c (format nil "~10:d" (report-sdump-count *report*))
      :d (report-sdump-progress *report*))

    (monitor-mode-gui-show-line w g (incf line)
      :b "sql"
      :c (format nil "~10:d" (report-sql-count *report*))
      :d (report-sql-progress *report*))

    (monitor-mode-gui-show-line w g (incf line)
      :b "schunk"
      :c (format nil "~10:d" (report-schunk-count *report*))
      :d (report-schunk-progress *report*))

    (monitor-mode-gui-show-line w g (incf line)
      :b "dchunk"
      :c (format nil "~10:d" (report-dchunk-count *report*))
      :d (report-dchunk-progress *report*))

    (monitor-mode-gui-show-line w g (incf line)
      :b "idump"
      :c (format nil "~10:d" (report-idump-count *report*))
      :d (report-idump-progress *report*))

    (monitor-mode-gui-show-line w g (incf line)
      :b "ichunk"
      :c (format nil "~10:d" (report-ichunk-count *report*))
      :d (report-ichunk-progress *report*))

    (monitor-mode-gui-show-line w g (incf line)
      :b "images"
      :c (format nil "~10:d" (report-images-count *report*))
      :d (report-images-progress *report*))

    ;; InnoDB
    (monitor-mode-gui-show-line w g (incf line)
      :a "InnoDB:")

    (monitor-mode-gui-show-line w g (incf line)
      :b "buffer pool pages dirty" 
      :c (format nil "~10:d" (report-innodb-buffer-pool-pages-dirty
				      *report*))
      :d (report-innodb-buffer-pool-pages-dirty-progress *report*))

    (monitor-mode-gui-show-line w g (incf line)
      :b "buffer pool pages insert"
      :c (format nil "~10:d" (report-innodb-buffer-pool-pages-insert *report*))
      :d (report-innodb-buffer-pool-pages-insert-progress *report*))

    ;; System
    (monitor-mode-gui-show-line w g (incf line)
      :a "System:")

    (monitor-mode-gui-show-line w g (incf line)
      :b "images partition free"
      :c (format-integer-for-human (report-partition-images-free *report*))
      :d (report-partition-images-free-to-size-ratio *report*))
    (monitor-mode-gui-show-line w g (incf line)
      :b "InnoDB partition free"
      :c (format-integer-for-human (report-partition-innodb-free *report*))
      :d (report-partition-innodb-free-to-size-ratio *report*))
    ))

(defun monitor-mode-gui-show-rule (w gcontexts l)
  "Showing a rule under line l"
  (let* ((ww       (xlib:drawable-width   w))
	 (g        gcontexts)
	 (ge       (gethash 'edge  g))
	 (gf       (gethash 'fill  g))
	 (gt       (gethash 'text  g))
	 (f        (xlib:gcontext-font  gt))
	 (fa       (xlib:font-ascent     f))
	 (fiws     (xlib:text-extents f " ")); inter-word space
	 (lh       (floor (* 1.4 fa)))       ; line spacing
	 (ax       (+       fiws))           ; col a x
	 (ay       (* l lh))
	 (y        (- ay (floor (* lh 0.3)))))
    (xlib:draw-line w gt ax y (- ww ax) y)))

(defun monitor-mode-gui-show-line (w gcontexts l &key 
				     (a nil) (b nil) (c nil) (d nil) (put nil))
  "Showing one line for monitor screen mode"
  ;; we very carefully define (x,y,w,h) for each cell (a,b,c,d,e)
  (let* ((d        (if (numberp d)
		       (value-within-bound 0 d 1.0)    ; [0,1]
		     d))                     ; string
	 (e        (when (numberp d)
		     (format nil "~5,2f%" (* d 100)))) ; percent progress
	 (g        gcontexts)
	 (ge       (gethash 'edge  g))
	 (gf       (gethash 'fill  g))
	 (gt       (gethash 'text  g))
	 (f        (xlib:gcontext-font  gt))
	 (fa       (xlib:font-ascent     f))
	 (fd       (xlib:font-direction  f)) ; used for I18N
	 (fmcw     (xlib:max-char-width  f)) 
	 (fiws     (xlib:text-extents f " ")); inter-word space
	 (lh       (floor (* 1.4 fa)))       ; line spacing
	 (aw       (*  1 fmcw))              ; col a width
	 (bw       (* 10 fmcw))              ; col b width
	 (cw       (*  7 fmcw))
	 (dw       (* 26 fmcw))
	 (dw-bar   (cond ((numberp d) 
			  (floor (* dw d))) ; progress bar - filled
			 ((eql d :pulse)
			  (floor (* dw (/ (get-decoded-time) 60)))))) ; pulsed
	 (ew       (*  4 fmcw))
	 (ax       (+       fiws))           ; col a x
	 (bx       (+ ax aw fiws))           ; col b x
	 (cx       (+ bx bw fiws))
	 (cx-just  (when (stringp c)
		     (- (+ cx cw) (xlib:text-extents f c)))) ; right justify
	 (dx       (+ cx cw fiws))
	 (ex       (+ dx dw fiws))
	 (ex-just  (when (stringp e)
		     (- (+ ex ew) (xlib:text-extents f e)))) ; right justify
	 (ah       lh)                       ; col a height
	 (bh       lh)                       ; col b height
	 (ch       lh)
	 (dh       lh)
	 (dh-bar   fa)        ; progress bar thinner for readability
	 (eh       lh)
	 (ay       (* l lh))                 ; col a y
	 (by       ay)                       ; col b y
	 (cy       ay)
	 (dy       ay)
	 (dy-bar   (- ay fa)) ; progress bar thinner for readablity
	 (ey       ay))
    (unless (null a) (xlib:draw-glyphs    w gt ax      ay a))
    (unless (null b) (xlib:draw-glyphs    w gt bx      by b))
    (unless (null c) (xlib:draw-glyphs    w gt cx-just cy c))       ; justify
    (cond ((stringp d) (xlib:draw-glyphs  w gt dx      dy d))
	  ((and (numberp d) (eql d 1))
	   (xlib:draw-rectangle w gf dx dy-bar dw-bar dh-bar   t))  ; fill
	  ((or (numberp d) (eql d :pulse))
	   (xlib:draw-rectangle w ge dx dy-bar dw     dh-bar nil)   ; edge
	   (xlib:draw-rectangle w gf dx dy-bar dw-bar dh-bar   t))  ; fill
	  (t nil))
    (cond ((eql d :pulse) (xlib:draw-glyphs    w gt ex      ey "pulse"))
          ((and (stringp e) (string= e " 0.00%")) nil)
          ((and (stringp e) (string= e "100.00%"))
	                  (xlib:draw-glyphs    w gt ex      ey "done"))
          ((stringp e)    (xlib:draw-glyphs    w gt ex-just ey e))) ; justify
    ))

(defun monitor-mode-screen (&key (put nil))
  "Running the monitor in screen mode"
  (put-message-start (_ "attempting screen mode"))
  (unwind-protect
      (screen:with-window
       (defparameter *monitor-screen-stream* screen:*window*)
       (multiple-value-bind (height width)
	   (screen:window-size *monitor-screen-stream*)
	 (defparameter *monitor-screen-height* height)
	 (defparameter *monitor-screen-width*  width)
	 (when (and (> *monitor-screen-height* 0)
		    (> *monitor-screen-width*  0))
	   (loop named screen    ; user terminates with Control-C 
	     do
	       (monitor-data-collect :put put)
	       (monitor-mode-screen-show)
	       (sleep *monitor-poll-sec*)))))
    (put-message-done (_ "attempting screen mode"))))

(defun monitor-mode-screen-show (&key (put nil))
  "Showing status in screen format"
  (let ((w    *monitor-screen-stream*)
	(wh   (1- *monitor-screen-height*))
	(ww   (1- *monitor-screen-width* ))
	(line 0))

    ;; clear screen first
    (screen:window-cursor-off  w)
    (screen:clear-window       w)

    ;; borders
    (monitor-mode-screen-show-box)

    ;; caption
    (monitor-mode-screen-show-line line
      :a "WP-MIRROR"
      :d "MONITOR MODE")
    (screen:set-window-cursor-position      w  0 (- ww 1
			(length (report-timestamp *report*))))
    (princ (report-timestamp *report*) w)

    ;; type
    (monitor-mode-screen-show-line (incf line)
      :a "Process:             ")

    (monitor-mode-screen-show-line (incf line)
      :b "database           "
      :c (format nil "~10:d" (report-database-count *report*))
      :d (format-progress-bar-string 
	  (report-database-progress *report*)))

    (monitor-mode-screen-show-line (incf line)
      :b "table              " 
      :c (format nil "~10:d" (report-table-count *report*))
      :d (format-progress-bar-string
	  (report-table-progress *report*)))

    (monitor-mode-screen-show-line (incf line)
      :b "checksum           "
      :c (format nil "~10:d" (report-checksum-count *report*))
      :d (format-progress-bar-string
	  (report-checksum-progress *report*)))

    (monitor-mode-screen-show-line (incf line)
      :b "xdump              "
      :c (format nil "~10:d" (report-xdump-count *report*))
      :d (format-progress-bar-string 
	  (report-xdump-progress *report*)))

    (monitor-mode-screen-show-line (incf line)
      :b "xml                "
      :c (format nil "~10:d" (report-xml-count *report*))
      :d (format-progress-bar-string 
	  (report-xml-progress *report*)))

    (monitor-mode-screen-show-line (incf line)
      :b "xchunk             "
      :c (format nil "~10:d" (report-xchunk-count *report*))
      :d (format-progress-bar-string 
	  (report-xchunk-progress *report*)))

    (monitor-mode-screen-show-line (incf line)
      :b "sdump              "
      :c (format nil "~10:d" (report-sdump-count *report*))
      :d (format-progress-bar-string 
	  (report-sdump-progress *report*)))

    (monitor-mode-screen-show-line (incf line)
      :b "sql                "
      :c (format nil "~10:d" (report-sql-count *report*))
      :d (format-progress-bar-string 
	  (report-sql-progress *report*)))

    (monitor-mode-screen-show-line (incf line)
      :b "schunk             "
      :c (format nil "~10:d" (report-schunk-count *report*))
      :d (format-progress-bar-string 
	  (report-schunk-progress *report*)))

    (monitor-mode-screen-show-line (incf line)
      :b "dchunk             "
      :c (format nil "~10:d" (report-dchunk-count *report*))
      :d (format-progress-bar-string 
	  (report-schunk-progress *report*)))

    (monitor-mode-screen-show-line (incf line)
      :b "idump              "
      :c (format nil "~10:d" (report-idump-count *report*))
      :d (format-progress-bar-string 
	  (report-idump-progress *report*)))

    (monitor-mode-screen-show-line (incf line)
      :b "ichunk             "
      :c (format nil "~10:d" (report-ichunk-count *report*))
      :d (format-progress-bar-string 
	  (report-ichunk-progress *report*)))

    (monitor-mode-screen-show-line (incf line)
      :b "images             "
      :c (format nil "~10:d" (report-images-count *report*))
      :d (format-progress-bar-string 
	  (report-images-progress *report*)))

    ;; InnoDB
    (monitor-mode-screen-show-line (incf line)
      :a "InnoDB:              ")

    (monitor-mode-screen-show-line (incf line)
      :b "buffer pool dirty  " 
      :c (format nil "~10:d" (report-innodb-buffer-pool-pages-dirty *report*))
      :d (format-progress-bar-string
	  (report-innodb-buffer-pool-pages-dirty-progress *report*)))

    (monitor-mode-screen-show-line (incf line)
      :b "buffer pool insert "
      :c (format nil "~10:d" (report-innodb-buffer-pool-pages-insert *report*))
      :d (format-progress-bar-string
	  (report-innodb-buffer-pool-pages-insert-progress *report*)))

    ;; System
    (monitor-mode-screen-show-line (incf line)
      :a "System:")

    (monitor-mode-screen-show-line (incf line)
      :b "images partition free"
      :c (format nil "~10@a" (format-integer-for-human 
			      (report-partition-images-free *report*)))
      :d (format-progress-bar-string
	  (report-partition-images-free-to-size-ratio *report*)))
    (monitor-mode-screen-show-line (incf line)
      :b "InnoDB partition free"
      :c (format nil "~10@a" (format-integer-for-human 
			      (report-partition-innodb-free *report*)))
      :d (format-progress-bar-string
	  (report-partition-innodb-free-to-size-ratio *report*)))
    
    ;; park cursor in corner
    (screen:set-window-cursor-position      w wh ww)
))

(defun monitor-mode-screen-show-box (&key (put nil))
  "Showing box bordering the screen"
  (let ((w  *monitor-screen-stream*)
	(wh (1- *monitor-screen-height*))
	(ww (1- *monitor-screen-width* )))
    ;; edges
    (loop 
      for i of-type integer from 0 to ww do 
      (screen:set-window-cursor-position    w  0  i) (princ "-" w)
      (screen:set-window-cursor-position    w wh  i) (princ "-" w))
    (loop 
      for i of-type integer from 1 to wh do
      (screen:set-window-cursor-position    w  i  0) (princ "|" w)
      (screen:set-window-cursor-position    w  i ww) (princ "|" w))
    ;; corners
    (screen:set-window-cursor-position      w  0  0) (princ "+" w)
    (screen:set-window-cursor-position      w wh  0) (princ "+" w)
    (screen:set-window-cursor-position      w  0 ww) (princ "+" w)
    (screen:set-window-cursor-position      w wh ww) (princ "+" w)))

(defun monitor-mode-screen-show-line (y &key (a nil) (b nil) (c nil) (d nil))
  "Showing one line for monitor screen mode"
  ;; left-align four strings (a,b,c,d) on columns (a-col,b-col,c-col,d-col)
  (let ((w  *monitor-screen-stream*)
	(wh (1- *monitor-screen-height*))
	(a-col   2)
	(b-col   4)
	(c-col  23)
	(d-col  34))
    (when (< y wh)
      (unless (null a) (screen:set-window-cursor-position w y a-col)
	      (princ a w))
      (unless (null b) (screen:set-window-cursor-position w y b-col)
	      (princ b w))
      (unless (null c) (screen:set-window-cursor-position w y c-col) 
	      (princ c w))
      (unless (null d) (screen:set-window-cursor-position w y d-col) 
	      (princ d w)))
    ))

(defun monitor-mode-text (&key (put nil))
  "Running the monitor in text mode"
  (loop                  ; user terminates with Control-C 
    do
      (put-message-start (_"monitor mode text loop") :put t)
      (monitor-data-collect :put put)
      (monitor-mode-text-show :put t)
      (sleep *monitor-poll-sec*)))

(defun monitor-mode-text-show (&key (put t))
  "Showing status in text format"
  (put-message-value (_ "WP-MIRROR Progress Report")
                     (report-timestamp                      *report*)   :put t)
  ;; Type
  (put-message-value (_ "database count")
		     (report-database-count                 *report*)   :put t)
  (put-message-value (_ "table count")
		     (report-table-count                    *report*)   :put t)
  (put-message-value (_ "checksum count")
		     (report-checksum-count                 *report*)   :put t)
  (put-message-value (_ "xdump count")
		     (report-xdump-count                    *report*)   :put t)
  (put-message-value (_ "xml count")
		     (report-xml-count                      *report*)   :put t)
  (put-message-value (_ "xchunk count")
		     (report-xchunk-count                   *report*)   :put t)
  (put-message-value (_ "sdump count")
		     (report-sdump-count                    *report*)   :put t)
  (put-message-value (_ "sql count")
		     (report-sql-count                      *report*)   :put t)
  (put-message-value (_ "dchunk count")
		     (report-dchunk-count                   *report*)   :put t)
  (put-message-value (_ "schunk count")
		     (report-schunk-count                   *report*)   :put t)
  (put-message-value (_ "idump count")
		     (report-idump-count                    *report*)   :put t)
  (put-message-value (_ "ichunk count")
		     (report-ichunk-count                   *report*)   :put t)
  (put-message-value (_ "images count")
		     (report-images-count                   *report*)   :put t)
  (put-message-value (_ "database progress")
		     (format-progress-bar-string
		      (report-database-progress             *report*))  :put t)
  (put-message-value (_ "table progress")
		     (format-progress-bar-string
		      (report-table-progress                *report*))  :put t)
  (put-message-value (_ "checksum progress")
		     (format-progress-bar-string
		      (report-checksum-progress             *report*))  :put t)
  (put-message-value (_ "xdump progress")
		     (format-progress-bar-string
		      (report-xdump-progress                *report*))  :put t)
  (put-message-value (_ "xml progress")
		     (format-progress-bar-string
		      (report-xml-progress                  *report*))  :put t)
  (put-message-value (_ "xchunk progress")
		     (format-progress-bar-string
		      (report-xchunk-progress               *report*))  :put t)
  (put-message-value (_ "sdump progress")
		     (format-progress-bar-string
		      (report-sdump-progress                *report*))  :put t)
  (put-message-value (_ "sql progress")
		     (format-progress-bar-string
		      (report-sql-progress                  *report*))  :put t)
  (put-message-value (_ "schunk progress")
		     (format-progress-bar-string
		      (report-schunk-progress               *report*))  :put t)
  (put-message-value (_ "dchunk progress")
		     (format-progress-bar-string
		      (report-dchunk-progress               *report*))  :put t)
  (put-message-value (_ "idump progress")
		     (format-progress-bar-string
		      (report-idump-progress                *report*))  :put t)
  (put-message-value (_ "ichunk progress")
		     (format-progress-bar-string
		      (report-ichunk-progress               *report*))  :put t)
  (put-message-value (_ "images progress")
		     (format-progress-bar-string
		      (report-images-progress               *report*))  :put t)
  ;; InnoDB
  (put-message-value (_ "InnoDB buffer pages dirty")
		     (format-progress-bar-string
		      (report-innodb-buffer-pool-pages-dirty-progress
		                                            *report*))  :put t)
  (put-message-value (_ "InnoDB buffer pages insert")
		     (format-progress-bar-string
		      (report-innodb-buffer-pool-pages-insert-progress
		                                            *report*))  :put t)
  ;; System
  (put-message-value (_ "images partition free/size")
		     (format nil "~a/~a"
			     (format-integer-for-human
			      (report-partition-images-free *report*))
			     (format-integer-for-human
			      (report-partition-images-size *report*))) :put t)
  (put-message-value (_ "InnoDB partition free/size")
		     (format nil "~a/~a"
			     (format-integer-for-human
			      (report-partition-innodb-free *report*))
			     (format-integer-for-human
			      (report-partition-innodb-size *report*))) :put t)
  )

(defun main-monitor (&key (put nil))
  "Purpose: Main function when wp-mirror is in Monitor Mode."
  ;; 2) Determine monitor mode (:auto, :gui, :screen, :text)
  (put-message (_ "-----monitor-mode-begin-----------------------") :put t)
  (monitor-mode-gui-screen-or-text :put put)
  (case *monitor-mode*
	(:gui    (monitor-mode-gui    :put put))
	(:screen (monitor-mode-screen :put put))
	(:text   (monitor-mode-text   :put put)))
  (put-message (_ "-----monitor-mode-done------------------------") :put put))


;;;;--------------------------------------------------------------------------+
;;;; Main:                                                                    |
;;;;   Determine main mode of operation :first-mirror, :next-mirror, :monitor |
;;;;--------------------------------------------------------------------------+


(defun main (&key (put nil))
  (declare (optimize (safety 3)))
  (let* ((real-time-fsm-total-start   0)
	 (real-time-fsm-total-stop    0)
	 (real-time-grand-total-start (get-internal-real-time))
	 (real-time-grand-total-stop  0))
    (debug-message (_ "Hello, Dr. Miller."))
    ;; 0) Initialize
    (initialize-system                  :put put)
    ;; 1) Assert prerequisites
    (assert-prerequisite-software       :put put)
    (assert-prerequisite-hardware       :put put)
    ;; 2) Main modes
    (case *main-mode*
	  (:add
	   (main-add                             *main-wiki* :put put))
	  (:delete          
	   (main-delete                          *main-wiki* :put put))
	  (:drop
	   (main-drop                            *main-wiki* :put put))
	  (:dump
	   (main-dump                            *main-wiki* :put put))
	  (:first-mirror
	   (setq real-time-fsm-total-start (get-internal-real-time))
	   (main-mirror                                      :put put)
	   (setq real-time-fsm-total-stop  (get-internal-real-time))
	   (sql-insert-time "FSM-TOTAL" nil
			    (- real-time-fsm-total-stop 
			       real-time-fsm-total-start)    :put put))
	  (:next-mirror
	   (main-mirror                                      :put put))
	  (:monitor                     
	   (main-monitor                                     :put put))
	  (:profile
	   (main-profile                         *main-run*  :put put))
	  (:restore-default
	   (main-restore                                     :put put))
	  (:update
	   (main-update                          *main-wiki* :put put))
	  (otherwise nil))
    ;; 3) Finalize
    (finalize-system                :put put)
    (debug-message (_ "Goodbye, Dr. Miller."))
    (setq real-time-grand-total-stop  (get-internal-real-time))
    (when (eql *main-mode* :first-mirror)
      (sql-insert-time "GRAND-TOTAL" nil (- real-time-grand-total-stop 
					    real-time-grand-total-start) 
		       :put put)))
  (ext:exit 0))

;;;;--------------------------------------------------------------------------+
;;;; Compiled functions.                                                      |
;;;;--------------------------------------------------------------------------+

;;;
;;; Design note:
;;;
;;; In `common-lisp' it is customary to compile just the functions
;;; that consume the most time.
;;;
;;; The following two functions are obsolete. However, I leave the
;;; (commented) code as a reminder of what to do if some other
;;; function proves to be expensive.
;;;

;(compile 'fsm-images-validate)                       ; to optimize for speed
;(compile 'parse-image-file-names)                    ; to optimize for speed

(main :put nil)

;;;;--------------------------------------------------------------------------+
;;;; Obsolete functions.                                                      |
;;;;--------------------------------------------------------------------------+


(defun known-image-extension-p (string)
  "Matching with known file extensions"
  (or (regexp:match "\\.jpg$"  string :ignore-case t) ; jpg
      (regexp:match "\\.jpeg$" string :ignore-case t) ; jpeg
      (regexp:match "\\.png$"  string :ignore-case t) ; png
      (regexp:match "\\.gif$"  string :ignore-case t) ; gif
      (regexp:match "\\.svg$"  string :ignore-case t) ; svg
      (regexp:match "\\.pdf$"  string :ignore-case t) ; pdf
      (regexp:match "\\.tif$"  string :ignore-case t) ; tif
      (regexp:match "\\.tiff$" string :ignore-case t) ; tiff
      (regexp:match "\\.ogg$"  string :ignore-case t) ; ogg
      (regexp:match "\\.djvu$" string :ignore-case t) ; djvu
      (regexp:match "\\.wav$"  string :ignore-case t) ; wav
      (regexp:match "\\.mid$"  string :ignore-case t) ; mid
      (regexp:match "\\.fig$"  string :ignore-case t) ; fig
      (regexp:match "\\.bmp$"  string :ignore-case t) ; bmp
      (regexp:match "\\.xcf$"  string :ignore-case t) ; xcf
      (regexp:match "\\.dia$"  string :ignore-case t) ; dia
      (regexp:match "\\.mp3$"  string :ignore-case t) ; mp3
      (regexp:match "\\.psp$"  string :ignore-case t) ; psp
      (regexp:match "\\.bz2$"  string :ignore-case t) ; bz2
      (regexp:match "\\.mov$"  string :ignore-case t) ; mov
      ))

(defun shell-curl-ftp-connection (&key (silent t) (put nil))
  "Asserting internet access to wikimedia site"
  (let* ((url     (join (subseq
			 (regexp:regexp-split "/" *wikimedia-site-xdump*) 0 3)
			"/"))
	 (command-string (concatenate 'string
			      (format nil "~a " *whereis-curl*)
			      (when silent "--silent ")
			      "--ftp-port - "
			      url))
	 (result  (shell-command command-string :output :read-lines :put put))
	 (error-p (regexp:match "HTML" (first result))))
    (put-message result :put put)
    (and
     (not error-p)
     (not (null result)))))

(defun shell-curl-ftp-directory-list (url &key (silent t) (put nil))
  "Downloading directory list from URL, return list of strings"
  (let* ((command-string (concatenate 'string
				      (format nil "~a " *whereis-curl*)
				      (when silent "--silent ")
				      "--ftp-port - "
				      url))
	 (lines          (shell-command command-string :output :read-lines
					:put put))
	 (result         (loop
			   for line in lines
			   collect (first
				    (last (regexp:regexp-split " " line))))))
    (put-message result :put put)
    result))

(defun shell-curl-ftp-file (url file-name &key (silent t) (put nil))
  "Downloading file from URL, save as file-name"
  (let* ((command-string (concatenate 'string
				      (format nil "~a " *whereis-curl*)
				      "--continue-at - --retry 1 --fail "
				      (when silent "--silent ")
				      "--ftp-port - "
				      url))
	 (result (shell-command command-string :output file-name
				:if-output-exists :overwrite :put put)))
    (put-message result :put put)
    result))

(defun shell-curl-ftp-file-head (url &key (put nil))
  "Downloading HTTP head from URL, return list of strings"
  ;; `curl --head (HTTP/FTP/FILE)' returns file size and last modification time
  (shell-curl-http-file-head url :put put))

(defun shell-curl-http-connection (&key (silent t) (put nil))
  "Asserting internet access to wikimedia site"
  (let* ((url     (join (subseq
			 (regexp:regexp-split "/" *wikimedia-site-xdump*) 0 3)
			"/"))
	 (command-string (concatenate 'string
			      (format nil "~a --head --location "
				      *whereis-curl*)
			      (when silent "--silent ")
			      url))
	 (result  (shell-command command-string :output :read-lines :put put)))
    (put-message result :put put)
    (not (null result))))

(defun shell-curl-http-directory-list (url &key (silent t) (put nil))
  "Downloading directory list from URL, return list of strings"
  (let* ((command-string (concatenate 'string
			      (format nil "~a --location " *whereis-curl*)
			      (when silent "--silent ")
			      url))
	 (lines     (shell-command command-string :output :read-lines :put put))
	 (href-list (loop
		      for line in lines
		      as match = (regexp:match "href=\"[^\"]*" line)
		      as item = (and match
				     (subseq line
					     (+ (regexp:match-start match) 6)
					     (regexp:match-end match)))
		      when (and item
				(not (regexp:match "?"     item))
				(not (regexp:match ":"     item))
				(not (regexp:match "css"   item))
				(not (regexp:match "html"  item))
				(not (regexp:match "other" item)))
		        when (char= (aref item (1- (length item))) #\/)
		          collect (subseq item 0 (1- (length item)))
                        else
		          collect item)))
    (put-message href-list :put put) 
    href-list))

(defun shell-curl-http-directory-list-alt (url &key (silent t) (put nil))
  "Downloading directory list from `rsync-dirlist-last-1-good.txt', return list of strings"
  ;;
  ;; Directory note:
  ;;
  ;; At some sites `*wikimedia-site-xdump*' contains an `index.html'
  ;; file that prevents scraping a directory listing from HTML.  
  ;;
  ;; Some sites offer a `rsync-dirlist-last-1-good.txt' file
  ;; containing a list of wikis.  If not, then we look for the message:
  ;;
  ;; <p>The requested URL /rsync-dirlist-last-1-good.txt was not found
  ;; on this server.</p> or <title>404 - Not Found</title>
  ;;
  (let* ((url-last  (format nil "~a~a" url *wikimedia-site-xdump-dirlist*))
	 (command-string (concatenate 'string
			      (format nil "~a --location " *whereis-curl*)
			      (when silent "--silent ")
			      url-last))
	 (lines     (shell-command command-string :output :read-lines :put put))
	 (found-p   (not (loop
			   for line in lines
			   as  match = (regexp:match "not found" line
						     :ignore-case t)
			   thereis match)))
	 (wiki-list (and found-p
			 (loop
		           for line in lines
			   as  item = (second (regexp:regexp-split "/" line))
			   collect item))))
    (put-message command-string :put put)
    (put-message wiki-list :put put)
    wiki-list))

(defun shell-curl-http-file-head (url &key (silent t) (put nil))
  "Downloading HTTP head from URL, return list of strings"
  (let* ((command-string (concatenate 'string
			      (format nil "~a --head --fail --location "
				      *whereis-curl*)
			      (when silent "--silent ")
			      url)))
    (shell-command command-string :output :read-lines :put nil)))

(defun shell-curl-http-head (url file-name &key (silent t) (put nil))
  "Downloading HTTP head from URL, result stored in `file-name.head'"
  (let* ((command-string (concatenate 'string
			      (format nil "~a --head --fail --location "
				      *whereis-curl*)
			      (when silent "--silent ")
			      url)))
    (shell-command command-string :output (format nil "~a.head" file-name)
		   :if-output-exists :overwrite :put nil)))

(defun shell-find-1k (dir-name &key (put nil))
  "Finding files smaller than 1k in given directory"
  (let ((command-string (format nil "find ~a -size 1k" dir-name)))
    (shell-command command-string :output :read-lines :put put)))

(defun page-title-edit (line &key (put nil))
  "Remove namespace tag from page title, return corrected line"
  ;;
  ;; Design note:
  ;;
  ;; 1) Problem.  WMF `xdump's have thousands of compound page
  ;; titles.  They appear with the namespace prepended. For example,
  ;; `simplewiki-20140220-pages-articles.xml.bz2' contains:
  ;;
  ;; `    <title>Template:Stub</title>'
  ;;
  ;; whereas the database field `page_title' requires:
  ;;
  ;; `Stub'.
  ;;
  ;; This compound has been seen for pages from the following namespaces:
  ;; Category, Help, MediaWiki, Module, Property, Template, and Wikipedia.
  ;;
  ;; 2) Consequence. Without correction, `MediaWiki' will be unable to
  ;; find the template (or other incorrectly named page) in the
  ;; underlying `simplewiki.page' table, and instead render a
  ;; red-link.
  ;;
  ;; 3) Solution. The offending namespace must be deleted.
  ;;
  ;;    order the test by most frequent first (simplewiki-20140220-pages...)
  (cond ((regexp:match "Category:"  line)                    ; 24575
	 (join (regexp:regexp-split "Category:"  line) nil))
        ((regexp:match "Template:"  line)                    ; 15082
	 (join (regexp:regexp-split "Template:"  line) nil))
        ((regexp:match "Wikipedia:" line)                    ;  4072
	 (join (regexp:regexp-split "Wikipedia:" line) nil))
        ((regexp:match "MediaWiki:" line)                    ;   520
	 (join (regexp:regexp-split "MediaWiki:" line) nil))
        ((regexp:match "Property:"  line)                    ;  1000
	 (join (regexp:regexp-split "Project:"   line) nil))
        ((regexp:match "Help:"      line)                    ;   108
	 (join (regexp:regexp-split "Help:"      line) nil))
        ((regexp:match "Module:"    line)                    ;    27
	 (join (regexp:regexp-split "Module:"    line) nil))
	(t line)))

(defun assert-configuration-files-p
  "Asserting configuration files"
  (and
   (assert-test-set-p
    #'(lambda (x) (ext:probe-pathname
		   (merge-pathnames
		    (parse-namestring *whereis-directory-mediawiki-config*)
		    (parse-namestring (symbol-value x)))))
    '(*whereis-file-mediawiki-config-alldblist*
      *whereis-file-mediawiki-config-initialisesettings*
      *whereis-file-mediawiki-config-localsettings*
      ;;*whereis-file-mediawiki-config-localsettings-account*
      *whereis-file-mediawiki-config-localsettings-wpmirror*)
    :put put)
   (assert-test-set-p
    #'(lambda (x) (ext:probe-pathname
		   (merge-pathnames
		    (parse-namestring *whereis-directory-mediawiki-maintenance*)
		    (parse-namestring (symbol-value x)))))
    '(*whereis-file-mediawiki-farm-update*
      *whereis-file-mediawiki-update*)
    :put put)))

(defun sql-update-images-to-pending (&key (put nil))
  "Updating all `images' to `pending'"
  (put-message-start (_ "updating state from `done' to `pending'") :put put)
  (put-message (_ "to have `chown' run again") :put put)
  ;; do just once (not once for each wiki)
  (let ((update (format nil "UPDATE `~a`.`file` SET `state`='pending' WHERE `wiki`='~a' AND `state`='done' AND `type`='images';"
			*db-wpmirror-name*
			(first (mirror-language-code-list :put put)))))
    (put-message update :put put)
    (query-database-and-return-stream update :put put)
    (put-message-done (_ "updating state from `done' to `pending'") :put put)
    t))

(defun string-to-md5sum (string &key (put nil))
  "Computing md5sum of a string, return as a 32 char hex string"
  (let* ((dummy2      (debug-message string))
	 (no-escape   (remove #\\ string))
	 (dummy3      (debug-message no-escape)))
    ;; compute md5sum
    (cond ((find #\` string)
	   ;; backquote OK, fail on unicode
	   (simple-string-to-md5sum no-escape :put put))
	   ;; unicode OK, fail on backquote
	  (t (shell-printf-md5sum string :put put)))))

(defun simple-string-to-md5sum (string &key (put nil))
  "Computing md5sum of a string, return as a 32 char hex string"
  ;; Handles backquote '`'
  ;; Bug: fail if neither simple-string nor (unsigned-byte 8)
  (put-message-start (format nil "string-to-md5sum ~a" string) :put put)
  (let* ((sequence  (md5:md5sum-sequence string))
	 (ident     (map 'list #'identity sequence))
	 (result    (format nil "~(~{~2,'0x~}~)" ident)))
    (put-message-value (_ "string-to-md5sum") result :put put)
    result))

(defparameter *wikimedia-interwiki-project-alist*
  '(("b"    . "wikibooks"  ) ("n"    . "wikinews"   ) ("q"    . "wikiquote"  )
    ("s"    . "wikisource" ) ("v"    . "wikiversity") ("voy"  . "wikivoyage" )
    ("w"    . "wikipedia"  ) ("wikt" . "wiktionary" )
    ))

(defun sql-delete-interwiki-link (database-name language-code &key (put nil))
  "Deleting interwiki link (interlanguage link actually)"
  (let ((delete (format nil "DELETE FROM `~a`.`interwiki` WHERE `iw_prefix`='~a';"
			database-name language-code)))
    (query-database-and-return-stream delete
				      :user     *db-wikiadmin-user*
				      :database nil
				      :put      put)))

(defun sql-insert-interwiki-link-list (wiki language-code-list &key (put nil))
  "Inserting set of interwiki links  (interlanguage links actually)"
  (let ((insert (make-array '(0) :element-type 'base-char
			         :fill-pointer 0 :adjustable t))
	(database-name (wiki-to-database-name wiki :put put)))
    (with-output-to-string (s insert)
      (format s "REPLACE INTO `~a`.`interwiki` " database-name)
      (format s "(`iw_prefix`,`iw_url`,`iw_local`,`iw_trans`,`iw_api`,`iw_wikiid`) ")
      (format s "VALUES ")
      (loop
       with project-name = (wiki-to-project wiki :put put)
       for language-code in language-code-list
       do (format s "('~a','~a',~d,~d,'~a','~a'),"
		  language-code
		  (format nil "http://~a.~a.site/wiki/$1"
			  language-code project-name)
		  1
		  0
		  (format nil "http://~a.~a.site/w/api.php"
			  language-code project-name)
		  database-name))
      (loop
       with language-code = (wiki-to-language-code wiki :put put)
       for (project-code . project-name) in *wikimedia-interwiki-project-alist*
       as  i from 1
       do (format s "('~a','~a',~d,~d,'~a','~a')"
		  project-code
		  (format nil "http://~a.~a.site/wiki/$1"
			  language-code project-name)
		  1
		  0
		  (format nil "http://~a.~a.site/w/api.php"
			  language-code project-name)
		  database-name)
          (if (eql i (length *wikimedia-interwiki-project-alist*))
	      (format s ";")
	    (format s ","))))
    (put-message insert :put put)
    (query-database-and-return-stream insert
				      :user     *db-wikiadmin-user*
				      :database nil
				      :put      put)))

(defun delete-interwiki-links (wiki &key (put nil))
  "Deleting interwiki links (interlanguage links actually)"
  (loop
   for language-code in (mirror-language-code-list :put put)
   as  wiki-name      = (format nil "~awiki" language-code)
   as  database-name  = (wiki-to-database-name wiki-name :put put)
   when (assert-database-p database-name :put put)
   do (sql-delete-interwiki-link database-name wiki-name :put put))
  t)
