From ea253c4515c9937e02cd6c6650a08733e4a9f7c5 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sat, 28 Sep 2019 23:55:11 +0100 Subject: [PATCH] Add a new script to process emails in an mbox file This can be used with the mbox files for the guix-commits mailing list to add older emails in to the database. --- .gitignore | 1 + Makefile.am | 1 + configure.ac | 1 + ...ata-service-process-branch-updated-mbox.in | 65 +++++++++++++++++++ 4 files changed, 68 insertions(+) create mode 100644 scripts/guix-data-service-process-branch-updated-mbox.in diff --git a/.gitignore b/.gitignore index e7327bd..5889951 100644 --- a/.gitignore +++ b/.gitignore @@ -23,6 +23,7 @@ scripts/guix-data-service-process-job scripts/guix-data-service-process-jobs scripts/guix-data-service-query-build-servers scripts/guix-data-service-process-branch-updated-email +scripts/guix-data-service-process-branch-updated-mbox test-env pre-inst-env diff --git a/Makefile.am b/Makefile.am index abc430c..fec91ad 100644 --- a/Makefile.am +++ b/Makefile.am @@ -25,6 +25,7 @@ bin_SCRIPTS = \ scripts/guix-data-service-process-job \ scripts/guix-data-service-process-jobs \ scripts/guix-data-service-process-branch-updated-email \ + scripts/guix-data-service-process-branch-updated-mbox \ scripts/guix-data-service-query-build-servers moddir = $(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION) diff --git a/configure.ac b/configure.ac index deace04..5fbbe1c 100644 --- a/configure.ac +++ b/configure.ac @@ -47,6 +47,7 @@ AC_CONFIG_FILES([scripts/guix-data-service], [chmod +x scripts/guix-data-service AC_CONFIG_FILES([scripts/guix-data-service-process-job], [chmod +x scripts/guix-data-service-process-job]) AC_CONFIG_FILES([scripts/guix-data-service-process-jobs], [chmod +x scripts/guix-data-service-process-jobs]) AC_CONFIG_FILES([scripts/guix-data-service-process-branch-updated-email], [chmod +x scripts/guix-data-service-process-branch-updated-email]) +AC_CONFIG_FILES([scripts/guix-data-service-process-branch-updated-mbox], [chmod +x scripts/guix-data-service-process-branch-updated-mbox]) AC_CONFIG_FILES([scripts/guix-data-service-query-build-servers], [chmod +x scripts/guix-data-service-query-build-servers]) AC_CONFIG_FILES([test-env:build-aux/test-env.in], [chmod +x test-env]) AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env]) diff --git a/scripts/guix-data-service-process-branch-updated-mbox.in b/scripts/guix-data-service-process-branch-updated-mbox.in new file mode 100644 index 0000000..7184e74 --- /dev/null +++ b/scripts/guix-data-service-process-branch-updated-mbox.in @@ -0,0 +1,65 @@ +#!@GUILE@ --no-auto-compile +-*- scheme -*- +-*- geiser-scheme-implementation: guile -*- +!# +;;; Guix Data Service -- Information about Guix over time +;;; Copyright © 2019 Christopher Baines +;;; +;;; This file is part of guix-data-service. +;;; +;;; guix-data-service 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. +;;; +;;; guix-data-service 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 the guix-data-service. If not, see . + +(use-modules (srfi srfi-1) + (srfi srfi-37) + (ice-9 textual-ports) + (ice-9 binary-ports) + (rnrs bytevectors) + (squee) + (email email) + (guix-data-service database) + (guix-data-service branch-updated-emails)) + +(with-postgresql-connection + "process-branch-updated-mbox" + (lambda (conn) + (for-each + (lambda (file) + (simple-format (current-error-port) + "reading: ~A\n" + file) + (for-each + (lambda (email-bytevector) + (display "." (current-error-port)) + (catch + #t + (lambda () + (with-throw-handler #t + (lambda () + (enqueue-job-for-email + conn + (parse-email email-bytevector))) + (lambda (key . args) + (display "\nerror: while parsing email\n" + (current-error-port)) + (simple-format (current-error-port) + "~A: ~A\n\n" + key + args) + (display-backtrace (make-stack #t) (current-error-port))))) + (lambda (key . args) #f))) + (call-with-input-file file + mbox->emails)) + + (display "\n" (current-error-port))) + (cdr (command-line)))))