From 497efa6a927fe31c956d3b6b2a0c569ee2b47662 Mon Sep 17 00:00:00 2001 From: cage Date: Sun, 11 Oct 2020 18:22:07 +0200 Subject: [PATCH] - [gemini] starting using certificates; - removed hardcoded 'xdg-open' binary name. --- Makefile.am | 27 ++++++++++--------- Makefile.in | 10 +++++-- configure | 56 +++++++++++++++++++++++++++++++++++++- configure.ac | 9 ++++++- src/config.lisp.in | 6 +++-- src/config.lisp.in.in | 47 ++++++++++++++++++++++++++++++++ src/constants.lisp | 3 +++ src/db.lisp | 20 +++++++++++--- src/gemini-viewer.lisp | 18 ++++++++++--- src/gemini/client.lisp | 59 ++++++++++++++++++++++++++++------------- src/gemini/package.lisp | 2 ++ src/os-utils.lisp | 22 +++++++++++++-- src/package.lisp | 14 +++++++--- 13 files changed, 243 insertions(+), 50 deletions(-) create mode 100644 src/config.lisp.in.in diff --git a/Makefile.am b/Makefile.am index 5cd2936..e82c639 100644 --- a/Makefile.am +++ b/Makefile.am @@ -15,33 +15,35 @@ # along with this program. # If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]]. -ACLOCAL_AMFLAGS = -I m4 +ACLOCAL_AMFLAGS = -I m4 -bin_SCRIPTS = tinmop +bin_SCRIPTS = tinmop -CLEANFILES = $(bin_SCRIPTS) $(CONF_PATH_FILE); +CLEANFILES = $(bin_SCRIPTS) $(CONF_PATH_FILE); -CONF_PATH_FILE = src/config.lisp +CONF_PATH_FILE = src/config.lisp -CONF_PATH_FILE_IN = src/config.lisp.in +CONF_PATH_FILE_IN = src/config.lisp.in -BUILT_SOURCES = $(CONF_PATH_FILE) +CONF_PATH_FILE_IN_IN = src/config.lisp.in.in -EXTRA_DIST = config.rpath m4/ChangeLog tinmop.asd README.org src \ +BUILT_SOURCES = $(CONF_PATH_FILE) + +EXTRA_DIST = config.rpath m4/ChangeLog tinmop.asd README.org src \ LICENSES.org COPYING etc/shared.conf etc/default-theme.conf \ etc/init.lisp compare_version.awk -SUBDIRS = po +SUBDIRS = po -dist_doc_DATA = README.org README.txt LICENSES.org CONTRIBUTING.org \ +dist_doc_DATA = README.org README.txt LICENSES.org CONTRIBUTING.org \ doc/man.org doc/send-toot.lisp NEWS.org ChangeLog -confdir = $(sysconfdir)/$(PACKAGE) +confdir = $(sysconfdir)/$(PACKAGE) -dist_conf_DATA = etc/init.lisp etc/next-previous-open.lisp \ +dist_conf_DATA = etc/init.lisp etc/next-previous-open.lisp \ etc/default-theme.conf etc/shared.conf -dist_man1_MANS = doc/tinmop.man +dist_man1_MANS = doc/tinmop.man $(PACKAGE): $(CONF_PATH_FILE) $(LISP_COMPILER) \ @@ -76,3 +78,4 @@ $(CONF_PATH_FILE): dist-hook: rm -fv $(top_distdir)/$(CONF_PATH_FILE) + rm -fv $(top_distdir)/$(CONF_PATH_FILE_IN) diff --git a/Makefile.in b/Makefile.in index 9481283..b50a5fc 100644 --- a/Makefile.in +++ b/Makefile.in @@ -121,7 +121,7 @@ DIST_COMMON = $(srcdir)/Makefile.am $(top_srcdir)/configure \ am__CONFIG_DISTCLEAN_FILES = config.status config.cache config.log \ configure.lineno config.status.lineno mkinstalldirs = $(install_sh) -d -CONFIG_CLEAN_FILES = quick_quicklisp.sh +CONFIG_CLEAN_FILES = quick_quicklisp.sh src/config.lisp.in CONFIG_CLEAN_VPATH_FILES = am__vpath_adj_setup = srcdirstrip=`echo "$(srcdir)" | sed 's|.|.|g'`; am__vpath_adj = case $$p in \ @@ -214,7 +214,8 @@ CTAGS = ctags CSCOPE = cscope DIST_SUBDIRS = $(SUBDIRS) am__DIST_COMMON = $(dist_man1_MANS) $(srcdir)/Makefile.in \ - $(srcdir)/quick_quicklisp.sh.in COPYING ChangeLog compile \ + $(srcdir)/quick_quicklisp.sh.in \ + $(top_srcdir)/src/config.lisp.in.in COPYING ChangeLog compile \ config.guess config.rpath config.sub install-sh missing DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) distdir = $(PACKAGE)-$(VERSION) @@ -308,6 +309,7 @@ MSGFMT = @MSGFMT@ MSGFMT_015 = @MSGFMT_015@ MSGMERGE = @MSGMERGE@ OBJEXT = @OBJEXT@ +OPENSSL = @OPENSSL@ PACKAGE = @PACKAGE@ PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ PACKAGE_NAME = @PACKAGE_NAME@ @@ -383,6 +385,7 @@ bin_SCRIPTS = tinmop CLEANFILES = $(bin_SCRIPTS) $(CONF_PATH_FILE); CONF_PATH_FILE = src/config.lisp CONF_PATH_FILE_IN = src/config.lisp.in +CONF_PATH_FILE_IN_IN = src/config.lisp.in.in BUILT_SOURCES = $(CONF_PATH_FILE) EXTRA_DIST = config.rpath m4/ChangeLog tinmop.asd README.org src \ LICENSES.org COPYING etc/shared.conf etc/default-theme.conf \ @@ -436,6 +439,8 @@ $(ACLOCAL_M4): $(am__aclocal_m4_deps) $(am__aclocal_m4_deps): quick_quicklisp.sh: $(top_builddir)/config.status $(srcdir)/quick_quicklisp.sh.in cd $(top_builddir) && $(SHELL) ./config.status $@ +src/config.lisp.in: $(top_builddir)/config.status $(top_srcdir)/src/config.lisp.in.in + cd $(top_builddir) && $(SHELL) ./config.status $@ install-binSCRIPTS: $(bin_SCRIPTS) @$(NORMAL_INSTALL) @list='$(bin_SCRIPTS)'; test -n "$(bindir)" || list=; \ @@ -1034,6 +1039,7 @@ $(CONF_PATH_FILE): dist-hook: rm -fv $(top_distdir)/$(CONF_PATH_FILE) + rm -fv $(top_distdir)/$(CONF_PATH_FILE_IN) # Tell versions [3.59,3.63) of GNU make to not export all variables. # Otherwise a system limit (for SysV at least) may be exceeded. diff --git a/configure b/configure index 2c82841..d7a57ff 100755 --- a/configure +++ b/configure @@ -590,6 +590,7 @@ ac_subst_vars='am__EXEEXT_FALSE am__EXEEXT_TRUE LTLIBOBJS LIBOBJS +OPENSSL XDG_OPEN GAWK BASH @@ -6412,6 +6413,58 @@ if test "$XDG_OPEN" = "no" ; then exit 1; fi +for ac_prog in openssl +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_OPENSSL+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $OPENSSL in + [\\/]* | ?:[\\/]*) + ac_cv_path_OPENSSL="$OPENSSL" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_OPENSSL="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +OPENSSL=$ac_cv_path_OPENSSL +if test -n "$OPENSSL"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OPENSSL" >&5 +$as_echo "$OPENSSL" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$OPENSSL" && break +done +test -n "$OPENSSL" || OPENSSL="no" + + +if test "$OPENSSL" = "no" ; then + as_fn_error $? "Can not find openssl binary." "$LINENO" 5 + exit 1; +fi + SBCL_MIN_VERSION="1.5.9"; @@ -6423,7 +6476,7 @@ if test "$SBCL_VERSION_OK" = "1" ; then exit 1; fi -ac_config_files="$ac_config_files Makefile quick_quicklisp.sh po/Makefile.in" +ac_config_files="$ac_config_files Makefile quick_quicklisp.sh po/Makefile.in src/config.lisp.in" cat >confcache <<\_ACEOF @@ -7179,6 +7232,7 @@ do "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; "quick_quicklisp.sh") CONFIG_FILES="$CONFIG_FILES quick_quicklisp.sh" ;; "po/Makefile.in") CONFIG_FILES="$CONFIG_FILES po/Makefile.in" ;; + "src/config.lisp.in") CONFIG_FILES="$CONFIG_FILES src/config.lisp.in" ;; *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; esac diff --git a/configure.ac b/configure.ac index b969d61..4d19564 100644 --- a/configure.ac +++ b/configure.ac @@ -62,6 +62,13 @@ if test "$XDG_OPEN" = "no" ; then exit 1; fi +AC_PATH_PROGS([OPENSSL],[openssl],[no]) + +if test "$OPENSSL" = "no" ; then + AC_MSG_ERROR([Can not find openssl binary.]) + exit 1; +fi + AC_PROG_MKDIR_P dnl check sbcl version @@ -74,6 +81,6 @@ if test "$SBCL_VERSION_OK" = "1" ; then exit 1; fi -AC_CONFIG_FILES([Makefile quick_quicklisp.sh po/Makefile.in]) +AC_CONFIG_FILES([Makefile quick_quicklisp.sh po/Makefile.in src/config.lisp.in]) AC_OUTPUT diff --git a/src/config.lisp.in b/src/config.lisp.in index 95787b3..6db116f 100644 --- a/src/config.lisp.in +++ b/src/config.lisp.in @@ -1,5 +1,3 @@ -;; tinmop: an humble gemini and pleroma client -;; Copyright (C) 2020 cage ;; 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 @@ -15,6 +13,10 @@ ;; along with this program. ;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]]. +(alexandria:define-constant +openssl-bin+ "/usr/bin/openssl" :test #'string=) + +(alexandria:define-constant +xdg-open-bin+ "/usr/bin/xdg-open" :test #'string=) + (defmacro with-return-untranslated ((untranslated) &body body) `(handler-bind ((i18n-conditions:no-translation-table-error (lambda (e) diff --git a/src/config.lisp.in.in b/src/config.lisp.in.in new file mode 100644 index 0000000..dd6aba0 --- /dev/null +++ b/src/config.lisp.in.in @@ -0,0 +1,47 @@ + +;; 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/][http://www.gnu.org/licenses/]]. + +(alexandria:define-constant +openssl-bin+ "@OPENSSL@" :test #'string=) + +(alexandria:define-constant +xdg-open-bin+ "@XDG_OPEN@" :test #'string=) + +(defmacro with-return-untranslated ((untranslated) &body body) + `(handler-bind ((i18n-conditions:no-translation-table-error + (lambda (e) + (declare (ignore e)) + (invoke-restart 'cl-i18n:return-untranslated)))) + (handler-case + (progn ,@body) + (i18n-conditions:no-translation (e) + (declare (ignorable e)) + #+debug-mode + (progn + (warn e) + ,untranslated) + #-debug-mode ,untranslated)))) + +(defun _ (a) + "get translated string" + (with-return-untranslated (a) + (cl-i18n:translate a))) + +(defun n_ (a b n) + "Get stranslated string with plural forms +- a the untranslated string template +- b the string template to return if no translation was found +- n the number of object mentioned in the string template" + (declare (ignore b)) + (with-return-untranslated (a) + (cl-i18n:ntranslate a a n))) diff --git a/src/constants.lisp b/src/constants.lisp index 3a828ba..3999b91 100644 --- a/src/constants.lisp +++ b/src/constants.lisp @@ -83,3 +83,6 @@ For bug report please point your browser to: (define-constant +mention-prefix+ "@" :test #'string= :documentation "The prefix for a mention in a message") + +(define-constant +cache-tls-certificate-type+ "certificate" :test #'string= + :documentation "The cache type for TLS certificate") diff --git a/src/db.lisp b/src/db.lisp index dc55695..3d713cb 100644 --- a/src/db.lisp +++ b/src/db.lisp @@ -247,6 +247,7 @@ :autogenerated-id-p t :autoincrementp t) "key TEXT NOT NULL," + "type TEXT NOT NULL," ;; timestamp " \"created-at\" TEXT NOT NULL," ;; timestamp @@ -2721,7 +2722,7 @@ conversation removed (default: remove)" (now) (:= :key key))))) -(defun cache-put (key) +(defun cache-put (key &optional (type "generic")) "Insert a new cahe row with key `key'" (if (cache-get key) (with-db-transaction @@ -2730,8 +2731,8 @@ conversation removed (default: remove)" (with-db-transaction (with-db-current-timestamp (now) (query (make-insert +table-cache+ - (:key :created-at :accessed-at) - (key now now))) + (:key :type :created-at :accessed-at) + (key type now now))) (last-inserted-rowid))))) (defun cache-get (key) @@ -2752,7 +2753,7 @@ conversation removed (default: remove)" (defun cache-expired-p (key &key (days-in-the-past (swconf:config-purge-cage-days-offset))) "Return non nil if the last time the cache was accessed was older -than `days-in-the-past' days (default: `(swconf:config-purge-cage-days-offset)'" +than `days-in-the-past' days (default: `(swconf:config-purge-cache-days-offset)'" (let ((row (cache-get key))) (if (null row) t @@ -2777,3 +2778,14 @@ than `days-in-the-past' days (default: `(swconf:config-purge-cage-days-offset)'" (defun tofu-delete (host) (query (delete-from +table-gemini-tofu-cert+ (where (:= :host host))))) + +(defun ssl-cert-find (url) + (when-let* ((actual-text-looking-for (strcat url "%")) + (query (select :* + (from +table-cache+) + (where (:like :key + actual-text-looking-for)))) + (in-cache (fetch-single query)) + (id (getf in-cache :id))) + (strcat (os-utils:cached-file-path (to-s id)) + fs:*directory-sep* os-utils:+ssl-cert-name+))) diff --git a/src/gemini-viewer.lisp b/src/gemini-viewer.lisp index 619d6b7..f53ace8 100644 --- a/src/gemini-viewer.lisp +++ b/src/gemini-viewer.lisp @@ -360,7 +360,10 @@ (%fill-buffer))))))) (%fill-buffer)))))) -(defun request (url &key (enqueue nil) (do-nothing-if-exists-in-db t)) +(defun request (url &key + (enqueue nil) + (certificate nil) + (do-nothing-if-exists-in-db t)) (let ((parsed-uri (quri:uri url))) (maybe-initialize-metadata specials:*message-window*) (if (null parsed-uri) @@ -408,8 +411,9 @@ (multiple-value-bind (status code-description meta response socket) (gemini-client:request host path - :query query - :port port) + :client-certificate certificate + :query query + :port port) (add-url-to-history specials:*message-window* actual-uri) (cond ((gemini-client:response-redirect-p status) @@ -427,6 +431,14 @@ (format nil (_ "Redirects to ~s, follows redirect? [y/N] ") meta)))) + ((gemini-client:response-certificate-requested-p status) + (let ((certificate (or (db:ssl-cert-find actual-uri) + (gemini-client:make-client-certificate actual-uri)))) + (assert certificate) + (request actual-uri + :enqueue enqueue + :do-nothing-if-exists-in-db do-nothing-if-exists-in-db + :certificate certificate))) ((gemini-client:response-input-p status) (get-user-input nil host meta)) ((gemini-client:response-sensitive-input-p status) diff --git a/src/gemini/client.lisp b/src/gemini/client.lisp index 8e0eaee..1a5251f 100644 --- a/src/gemini/client.lisp +++ b/src/gemini/client.lisp @@ -125,14 +125,23 @@ (header-code= header +53+) (header-code= header +59+))) -(defun header-not-implemented-p (header) - (or (header-code= header +60+) - (header-code= header +61+) +(defun header-certificate-failure-p (header) + (or (header-code= header +61+) (header-code= header +62+))) +(defun header-not-implemented-p (header) + (declare (ignore header)) + nil) + +(defun header-certificate-requested-p (header) + (header-code= header +60+)) + (defun response-input-p (code) (code= code +10+)) +(defun response-certificate-requested-p (code) + (code= code +60+)) + (defun response-sensitive-input-p (code) (code= code +11+)) @@ -245,17 +254,19 @@ meta stream)) ((or (header-input-request-p parsed-header) - (header-redirect-p parsed-header)) + (header-redirect-p parsed-header) + (header-certificate-requested-p parsed-header)) (results (find-code-class status-code) nil)) - ((or (header-permanent-failure-p parsed-header) - (header-temporary-failure-p parsed-header)) + ((or (header-permanent-failure-p parsed-header) + (header-temporary-failure-p parsed-header) + (header-certificate-failure-p parsed-header)) (let ((response-code (find-code-class status-code))) (error 'gemini-protocol-error :error-code (code response-code) :error-description (description response-code)))) - ((header-not-implemented-p parsed-header) - (error 'conditions:not-implemented-error - :text (_ "The server requested a certificate but client validation is not implemented by this program"))) + ;; ((header-not-implemented-p parsed-header) + ;; (error 'conditions:not-implemented-error + ;; :text (_ "The server requested a certificate but client validation is not implemented by this program"))) (t parsed-header)))))) @@ -265,7 +276,16 @@ (defun close-ssl-socket (socket) (usocket:socket-close socket)) -(defun request (host path &key (query nil) (port +gemini-default-port+)) +(defun make-client-certificate (uri) + (let* ((cache-id (db:cache-put uri +cache-tls-certificate-type+)) + (cert-dir (os-utils:cached-file-path (text-utils:to-s cache-id)))) + (fs:make-directory cert-dir) + (os-utils:generate-ssl-certificate cert-dir))) + +(defun request (host path &key + (query nil) + (port +gemini-default-port+) + (client-certificate nil)) (let* ((uri (make-gemini-uri host path query port)) (ctx (cl+ssl:make-context :verify-mode cl+ssl:+ssl-verify-none+))) (when query @@ -274,14 +294,15 @@ (let ((socket (usocket:socket-connect host port :element-type '(unsigned-byte 8)))) (unwind-protect (when socket - (let ((stream (usocket:socket-stream socket))) - (let* ((ssl-stream (cl+ssl:make-ssl-client-stream stream - :external-format nil - :unwrap-stream-p t - :verify nil - :hostname host)) - (request (format nil "~a~a~a" uri #\return #\newline)) - (cert-hash (crypto-shortcuts:sha512 (x509:dump-certificate ssl-stream)))) + (let* ((stream (usocket:socket-stream socket)) + (ssl-stream (cl+ssl:make-ssl-client-stream stream + :certificate client-certificate + :external-format nil + :unwrap-stream-p t + :verify nil + :hostname host)) + (request (format nil "~a~a~a" uri #\return #\newline)) + (cert-hash (crypto-shortcuts:sha512 (x509:dump-certificate ssl-stream)))) (if (not (db:tofu-passes-p host cert-hash)) (error 'gemini-tofu-error :host host) (progn @@ -289,4 +310,4 @@ (force-output ssl-stream) (multiple-value-bind (status description meta response) (parse-response ssl-stream) - (values status description meta response socket)))))))))))) + (values status description meta response socket))))))))))) diff --git a/src/gemini/package.lisp b/src/gemini/package.lisp index 46062c5..5dd1b7a 100644 --- a/src/gemini/package.lisp +++ b/src/gemini/package.lisp @@ -87,6 +87,7 @@ :gemini-tofu-error :make-gemini-file-response :host + :response-certificate-requested-p :response-input-p :response-sensitive-input-p :response-redirect-p @@ -104,4 +105,5 @@ :text-rendering-theme :gemini-file-response-p :close-ssl-socket + :make-client-certificate :request)) diff --git a/src/os-utils.lisp b/src/os-utils.lisp index b955a2f..1e9c041 100644 --- a/src/os-utils.lisp +++ b/src/os-utils.lisp @@ -26,6 +26,10 @@ "cpuinfo") :test #'string=) +(alexandria:define-constant +ssl-cert-name+ "cert.pem" :test #'string=) + +(alexandria:define-constant +ssl-key-name+ "key" :test #'string=) + (declaim (ftype (function () fixnum) cpu-number)) (defun cpu-number () @@ -40,7 +44,7 @@ (incf cpu-count))))) (defun xdg-open (file) - (uiop:launch-program (format nil "xdg-open '~a'" file) + (uiop:launch-program (format nil "~a '~a'" +xdg-open-bin+ file) :output nil)) (defun getenv (name) @@ -68,7 +72,7 @@ (multiple-value-bind (exe args) (external-editor) (let ((actual-args (if args - (list args) + (list (text-utils:split-words args)) nil))) (sb-ext:run-program exe (append actual-args @@ -88,3 +92,17 @@ (defun cached-file-path (filename) (text-utils:strcat (user-cache-dir) fs:*directory-sep* filename)) + +(defun generate-ssl-certificate (outdir) + (let* ((cert-file (text-utils:strcat outdir fs:*directory-sep* +ssl-cert-name+)) + (key-file (text-utils:strcat outdir fs:*directory-sep* +ssl-key-name+)) + (cmd-args (format nil + (text-utils:strcat "req -new -nodes -x509 -days 365 -batch " + "-keyout ~a -outform PEM -out ~a") + key-file + cert-file))) + (sb-ext:run-program +openssl-bin+ + (text-utils:split-words cmd-args) + :output nil + :error :output) + (values cert-file key-file))) diff --git a/src/package.lisp b/src/package.lisp index 03ea4bd..a45e218 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -24,7 +24,8 @@ :+program-name+ :+program-version+ :+issue-tracker+ - :+home-data-dir+ + :+openssl-bin+ + :+xdg-open-bin+ :_ :n_)) @@ -49,7 +50,8 @@ :+status-direct-visibility+ :+folder-direct-message-prefix+ :+folder-tag-prefix+ - :+mention-prefix+)) + :+mention-prefix+ + :+cache-tls-certificate-type+)) (defpackage :conditions (:use :cl @@ -308,6 +310,8 @@ :config :constants) (:export + :+ssl-cert-name+ + :+ssl-key-name+ :cpu-number :xdg-open :getenv @@ -315,7 +319,8 @@ :open-with-editor :exit-program :user-cache-dir - :cached-file-path)) + :cached-file-path + :generate-ssl-certificate)) (defpackage :text-utils (:use @@ -882,7 +887,8 @@ :cache-get-value :cache-expired-p :tofu-passes-p - :tofu-delete)) + :tofu-delete + :ssl-cert-find)) (defpackage :date-formatter (:use