From patchwork Wed Dec 29 09:16:05 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Mathieu Othacehe X-Patchwork-Id: 35757 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 9150C27BBEA; Wed, 29 Dec 2021 09:17:15 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL, SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 7C7BE27BBE9 for ; Wed, 29 Dec 2021 09:17:14 +0000 (GMT) Received: from localhost ([::1]:40990 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n2V57-0005oY-Mj for patchwork@mira.cbaines.net; Wed, 29 Dec 2021 04:17:13 -0500 Received: from eggs.gnu.org ([209.51.188.92]:60958) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n2V50-0005oB-Kd for guix-patches@gnu.org; Wed, 29 Dec 2021 04:17:06 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:36501) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n2V4w-0003hc-Dr for guix-patches@gnu.org; Wed, 29 Dec 2021 04:17:06 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n2V4w-00023Y-21 for guix-patches@gnu.org; Wed, 29 Dec 2021 04:17:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#52866] maintenance: Add a crash dump service. Resent-From: Mathieu Othacehe Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 29 Dec 2021 09:17:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 52866 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 52866@debbugs.gnu.org X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.16407693937862 (code B ref -1); Wed, 29 Dec 2021 09:17:01 +0000 Received: (at submit) by debbugs.gnu.org; 29 Dec 2021 09:16:33 +0000 Received: from localhost ([127.0.0.1]:48047 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n2V4S-00022k-Ik for submit@debbugs.gnu.org; Wed, 29 Dec 2021 04:16:33 -0500 Received: from lists.gnu.org ([209.51.188.17]:41944) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n2V4Q-00022c-OJ for submit@debbugs.gnu.org; Wed, 29 Dec 2021 04:16:31 -0500 Received: from eggs.gnu.org ([209.51.188.92]:60850) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n2V4Q-0005Kv-BY for guix-patches@gnu.org; Wed, 29 Dec 2021 04:16:30 -0500 Received: from [2001:470:142:3::e] (port=34228 helo=fencepost.gnu.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n2V4Q-0003da-2Y for guix-patches@gnu.org; Wed, 29 Dec 2021 04:16:30 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:Subject:To:From:in-reply-to: references; bh=ORKzsRVEzlL3k2GNuwpQR0qFMC2BzAG97dF8tibcJvc=; b=o9L0VKiQsfSA3j +sZtP6+aplmWq5r5L0E/egCM5XrTGV38LF/LrATxYpy7w/KCMnFRe2BKp++R58VOx9FsF4YBV9Ax7 TBcQeQX0ML+9lmj8t3HprFdt61LFNecgV0sYneHG5ZBpeMvn5hX7ABqWLOmq3nUEPZq5lGSy7/Wh+ ba2AB1GB+Dw0MSA1+Oi8lHi1OCqCQun2zx4Jq98cpv+8pdjGotL+kKqkEOVZC0wFR1embTZYHtTCm 5obI9jY63cUSOpWFvdAqn6CnuOb7P2OsXYc8g6Cx8C6Fvc8B7anjVLgHk2eX7W7v5RAxhJGTihGPq IIwk9u5nNQ9Ce2iP6XdA==; Received: from [2a01:cb18:832e:5f00:3563:417e:2a38:86d8] (port=51722 helo=meije) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n2V44-0003qw-3E for guix-patches@gnu.org; Wed, 29 Dec 2021 04:16:13 -0500 From: Mathieu Othacehe Date: Wed, 29 Dec 2021 10:16:05 +0100 Message-ID: <878rw3ixey.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.2 (gnu/linux) MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches Hello, Here's a patch that adds a crash dump service. The concept is simple, a Guile HTTP server is listening on "dump.guix.gnu.org". Crash reports can be uploaded using multipart forms in POST requests. They are then stored on Berlin. I have implemented the installer dump service. On a crash, it optionally submits an archive report containing the backtrace, the installer state, the syslog and dmesg logs. We could also upload other backtraces that are generated by the "guix" command itself, when running "guix pull" for instance. Thanks, Mathieu From 9e98df09813711b78249c1839b7cbe079dc46fa9 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Tue, 28 Dec 2021 16:16:14 +0100 Subject: [PATCH 1/1] Add a crash-dump service. --- hydra/crash-dump.scm | 243 ++++++++++++++++++++++++++++ hydra/modules/sysadmin/dns.scm | 3 +- hydra/modules/sysadmin/services.scm | 79 ++++++++- hydra/nginx/berlin.scm | 26 +++ 4 files changed, 349 insertions(+), 2 deletions(-) create mode 100755 hydra/crash-dump.scm diff --git a/hydra/crash-dump.scm b/hydra/crash-dump.scm new file mode 100755 index 0000000..6d94bfb --- /dev/null +++ b/hydra/crash-dump.scm @@ -0,0 +1,243 @@ +#!/run/current-system/profile/bin/guile \ +--no-auto-compile -e crash-dump -s +!# +;;;; crash-dump -- crash dump HTTP web server. +;;; Copyright © 2021 Mathieu Othacehe +;;; +;;; This file is part of Crash-dump. +;;; +;;; Crash-dump 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. +;;; +;;; Crash-dump 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 Crash-dump. If not, see . + +(use-modules (web server) + (web request) + (web response) + (web uri) + (webutils multipart) + (gcrypt base16) + (gcrypt hash) + (srfi srfi-1) + (srfi srfi-11) + (srfi srfi-26) + (rnrs bytevectors) + (rnrs io ports) + (ice-9 binary-ports) + (ice-9 getopt-long) + (ice-9 match)) + +(define %program-name + (make-parameter "crash-dump")) + +(define %program-version + (make-parameter "0.1")) + +;; The dumps output directory. +(define %output + (make-parameter #f)) + +;; The supported dump types. +(define %whitelist-dumps + '(installer-dump)) + +(define (show-help) + (format #t "Usage: ~a [OPTIONS]~%" (%program-name)) + (display "Run the crash-dump web server. + -o --output=DIR Crash dumps directory. + -p --port=NUM Port of the HTTP server. + --listen=HOST Listen on the network interface for HOST + -V, --version Display version + -h, --help Display this help message") + (newline)) + +(define (show-version) + "Display version information for COMMAND." + (simple-format #t "~a ~a~%" + (%program-name) (%program-version)) + (display "Copyright (C) 2021 the Guix authors +License GPLv3+: GNU GPL version 3 or later +This is free software: you are free to change and redistribute it. +There is NO WARRANTY, to the extent permitted by law.") + (newline) + (exit 0)) + +(define %options + '((output (single-char #\o) (value #t)) + (port (single-char #\p) (value #t)) + (listen (value #t)) + (version (single-char #\V) (value #f)) + (help (single-char #\h) (value #f)))) + +(define (getaddrinfo* host) + "Like 'getaddrinfo', but properly report errors." + (catch 'getaddrinfo-error + (lambda () + (getaddrinfo host)) + (lambda (key error) + (exit "lookup of host '~a' failed: ~a~%" + host (gai-strerror error))))) + +;;; A common buffer size value used for the TCP socket SO_SNDBUF option. +(define %default-buffer-size + (* 208 1024)) + +(define %default-socket-options + ;; List of options passed to 'setsockopt' when transmitting files. + (list (list SO_SNDBUF %default-buffer-size))) + +(define* (configure-socket socket #:key (level SOL_SOCKET) + (options %default-socket-options)) + "Apply multiple option tuples in OPTIONS to SOCKET, using LEVEL." + (for-each (cut apply setsockopt socket level <>) + options)) + +(define (open-server-socket address) + "Return a TCP socket bound to ADDRESS, a socket address." + (let ((sock (socket (sockaddr:fam address) SOCK_STREAM 0))) + (configure-socket sock #:options (cons (list SO_REUSEADDR 1) + %default-socket-options)) + (bind sock address) + sock)) + +(define (post-request? request) + "Return #t if REQUEST uses the POST method." + (eq? (request-method request) 'POST)) + +(define (request-path-components request) + "Split the URI path of REQUEST into a list of component strings. For +example: \"/foo/bar\" yields '(\"foo\" \"bar\")." + (split-and-decode-uri-path (uri-path (request-uri request)))) + +(define (preserve-connection-headers request response) + "Add REQUEST's 'connection' header, if any, to HEADERS, a list of response +headers." + (if (pair? response) + (let ((connection + (assq 'connection (request-headers request)))) + (append response + (if connection + (list connection) + '()))) + response)) + +(define* (not-found request + #:key (phrase "Resource not found") + ttl) + "Render 404 response for REQUEST." + (values (build-response #:code 404 + #:headers (if ttl + `((cache-control (max-age . ,ttl))) + '())) + (string-append phrase ": " + (uri-path (request-uri request))))) + +(define* (dump-port in out + #:optional len + #:key (buffer-size 16384) + (progress (lambda (t k) (k)))) + "Read LEN bytes from IN or as much data as possible if LEN is #f, and write +it to OUT, using chunks of BUFFER-SIZE bytes. Call PROGRESS at the beginning +and after each successful transfer of BUFFER-SIZE bytes or less, passing it +the total number of bytes transferred and the continuation of the transfer as +a thunk." + (define buffer + (make-bytevector buffer-size)) + + (define (loop total bytes) + (or (eof-object? bytes) + (and len (= total len)) + (let ((total (+ total bytes))) + (put-bytevector out buffer 0 bytes) + (progress + total + (lambda () + (loop total + (get-bytevector-n! in buffer 0 + (if len + (min (- len total) buffer-size) + buffer-size)))))))) + + ;; Make sure PROGRESS is called when we start so that it can measure + ;; throughput. + (progress + 0 + (lambda () + (loop 0 (get-bytevector-n! in buffer 0 + (if len + (min len buffer-size) + buffer-size)))))) + +(define (output-file file port) + (let ((checksum + (string-take + (bytevector->base16-string (port-sha256 port)) 8))) + (seek port 0 SEEK_SET) + (format #f "~a/~a-~a" (%output) file checksum))) + +(define (make-handler) + (define (handle request body) + (format #t "~a ~a~%" + (request-method request) + (uri-path (request-uri request))) + (if (post-request? request) ;reject GET, PUT, etc. + (match (request-path-components request) + ;; /upload + (("upload") + (match (parse-request-body request body) + (((? part? p)) + (let* ((name (string->symbol (part-name p))) + (file (part-body p)) + (filename (output-file name file))) + (if (memq name %whitelist-dumps) + (begin + (call-with-output-file filename + (lambda (port) + (dump-port file port))) + (values (build-response #:code 200) + (basename filename))) + (values (build-response #:code 400) + (format #f "The part name '~a' is not supported." + name))))) + (x (format #t "invalid content")))) + (x (not-found request))) + (not-found request))) + + (lambda (request body) + (let-values (((response response-body) + (handle request body))) + (values (preserve-connection-headers request response) + response-body)))) + +(define* (crash-dump #:optional (args (command-line))) + (let ((opts (getopt-long args %options))) + (cond + ((option-ref opts 'help #f) + (show-help) + (exit 0)) + ((option-ref opts 'version #f) + (show-version) + (exit 0)) + (else + (let* ((output (%output + (option-ref opts 'output "/tmp"))) + (port (string->number (option-ref opts 'port "8080"))) + (addr (match (getaddrinfo* + (option-ref opts 'listen "localhost")) + ((info _ ...) + (addrinfo:addr info)) + (() + (exit "lookup of host returned nothing")))) + (socket (open-server-socket + (make-socket-address (sockaddr:fam addr) + (sockaddr:addr addr) + port)))) + (run-server (make-handler) 'http `(#:socket ,socket))))))) diff --git a/hydra/modules/sysadmin/dns.scm b/hydra/modules/sysadmin/dns.scm index 53ae57a..c254e6d 100644 --- a/hydra/modules/sysadmin/dns.scm +++ b/hydra/modules/sysadmin/dns.scm @@ -104,6 +104,7 @@ ;; Services. ("issues" "" "IN" "A" berlin-ip4) ("monitor" "" "IN" "A" berlin-ip4) + ("dump" "" "IN" "A" berlin-ip4) ("logs" "" "IN" "A" bayfront-ip4) ("ci" "" "IN" "A" berlin-ip4) ("disarchive" "" "IN" "A" berlin-ip4) @@ -128,4 +129,4 @@ (origin "guix.gnu.org") (ns primary-ns) (entries guix.gnu.org.zone) - (serial 2021122114))))) + (serial 202212281643))))) diff --git a/hydra/modules/sysadmin/services.scm b/hydra/modules/sysadmin/services.scm index ab0ac5f..6c1edae 100644 --- a/hydra/modules/sysadmin/services.scm +++ b/hydra/modules/sysadmin/services.scm @@ -56,7 +56,8 @@ KiB MiB GiB TiB disarchive-configuration disarchive-service-type - goggles-service-type)) + goggles-service-type + crash-dump-service-type)) (define not-config? ;; Select (guix …) and (gnu …) modules, except (guix config). @@ -589,6 +590,7 @@ to a selected directory.") %nginx-mime-types %nginx-cache-activation + (service crash-dump-service-type) (cuirass-service #:branches branches #:systems systems #:nar-ttl nar-ttl) @@ -732,3 +734,78 @@ to a selected directory.") goggles-shepherd-services))) (default-value goggles) (description "Run Goggles, the IRC log web interface."))) + + +;;; +;;; Crash-dump. +;;; + +(define crash-dump + (program-file "crash-dump" + (with-extensions (list guile-gcrypt guile-webutils) + #~(begin + (setvbuf (current-output-port) 'line) + (setvbuf (current-error-port) 'line) + (format (current-error-port) "Starting crash-dump...~%") + + (load-compiled + #$(computed-file + "crash-dump.go" + #~(begin + (use-modules (system base compile)) + + (compile-file + #$(local-file "../../crash-dump.scm") + #:output-file #$output)))) + (crash-dump '("_" "-p" "2121")))))) + +(define (crash-dump-shepherd-services crash-dump) + (with-imported-modules (source-module-closure + '((gnu build shepherd) + (gnu system file-systems))) + (list (shepherd-service + (provision '(crash-dump)) + (requirement '(user-processes loopback)) + (documentation "Run Crash-dump.") + (modules '((gnu build shepherd) + (gnu system file-systems))) + (start #~(make-forkexec-constructor/container + (list #$crash-dump) + #:user "crash-dump" #:group "crash-dump" + #:log-file "/var/log/crash-dump.log" + ;; Run in a UTF-8 locale for proper rendering of the + ;; logs. + #:environment-variables + (list (string-append "GUIX_LOCPATH=" #$glibc-utf8-locales + "/lib/locale") + "LC_ALL=en_US.utf8"))) + (stop #~(make-kill-destructor)))))) + +(define %crash-dump-accounts + (list (user-account + (name "crash-dump") + (group "crash-dump") + (home-directory "/var/empty") + (create-home-directory? #f) + (shell (file-append shadow "/sbin/nologin")) + (comment "The Crash-dump web server") + (system? #t)) + (user-group + (name "crash-dump") + (system? #t)))) + +(define %crash-dump-log-rotations + (list (log-rotation + (files (list "/var/log/crash-dump.log"))))) + +(define crash-dump-service-type + (service-type + (name 'crash-dump) + (extensions (list (service-extension account-service-type + (const %crash-dump-accounts)) + (service-extension rottlog-service-type + (const %crash-dump-log-rotations)) + (service-extension shepherd-root-service-type + crash-dump-shepherd-services))) + (default-value crash-dump) + (description "Run a crash dump HTTP web server."))) diff --git a/hydra/nginx/berlin.scm b/hydra/nginx/berlin.scm index ecdbb13..aea7db0 100644 --- a/hydra/nginx/berlin.scm +++ b/hydra/nginx/berlin.scm @@ -318,6 +318,32 @@ PUBLISH-URL." "send_timeout 600;" "access_log /var/log/nginx/issues-guix-gnu-org.https.access.log;")))) + (nginx-server-configuration + (listen '("443 ssl")) + (server-name '("dump.guix.gnu.org")) + (ssl-certificate (le "dump.guix.gnu.org")) + (ssl-certificate-key (le "dump.guix.gnu.org" 'key)) + (locations + (list + (nginx-location-configuration ;certbot + (uri "/.well-known") + (body (list "root /var/www;"))) + (nginx-location-configuration + (uri "/") + (body '("proxy_pass http://localhost:2121;"))))) + (raw-content + (append + %tls-settings + (list + "proxy_set_header X-Forwarded-Host $host;" + "proxy_set_header X-Forwarded-Port $server_port;" + "proxy_set_header X-Forwarded-For $proxy_add_x_forwarded_for;" + "proxy_connect_timeout 600;" + "proxy_send_timeout 600;" + "proxy_read_timeout 600;" + "send_timeout 600;" + "access_log /var/log/nginx/dump-guix-gnu-org.https.access.log;")))) + (nginx-server-configuration (listen '("443 ssl")) (server-name '("guixwl.org" -- 2.34.0