Add some git stuff

Julien LepillerMon Sep 28 02:12:31+0200 2020

bee1d0a

Add some git stuff

modules/config/static-web.scm unknown status 1

1+
;;; GNU Guix system administration tools.
2+
;;;
3+
;;; Copyright ?? 2019, 2020 Ludovic Court??s <ludo@gnu.org>
4+
;;; Copyright ?? 2020 Ricardo Wurmus <rekado@elephly.net>
5+
;;;
6+
;;; This program is free software: you can redistribute it and/or modify
7+
;;; it under the terms of the GNU General Public License as published by
8+
;;; the Free Software Foundation, either version 3 of the License, or
9+
;;; (at your option) any later version.
10+
;;;
11+
;;; This program is distributed in the hope that it will be useful,
12+
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13+
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14+
;;; GNU General Public License for more details.
15+
;;;
16+
;;; You should have received a copy of the GNU General Public License
17+
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
18+
19+
20+
;;; NOTE: this file is taken from
21+
;;; https://git.savannah.gnu.org/cgit/guix/maintenance.git/plain/hydra/modules/sysadmin/web.scm
22+
23+
(define-module (config static-web)
24+
  #:use-module (guix git)
25+
  #:use-module (guix gexp)
26+
  #:use-module (guix modules)
27+
  #:use-module (guix packages)
28+
  #:use-module (guix records)
29+
  #:use-module (guix git-download)
30+
  #:use-module (gnu packages)
31+
  #:use-module (gnu packages autotools)
32+
  #:use-module (gnu packages graphviz)
33+
  #:use-module (gnu packages guile)
34+
  #:use-module (gnu packages guile-xyz)
35+
  #:use-module (gnu packages package-management)
36+
  #:use-module (gnu packages pkg-config)
37+
  #:use-module (gnu packages texinfo)
38+
  #:use-module (gnu services)
39+
  #:use-module (gnu services mcron)
40+
  #:use-module (gnu services shepherd)
41+
  #:use-module (gnu services web)
42+
  #:use-module (gnu system shadow)
43+
  #:use-module (ice-9 match)
44+
  #:export (build-program
45+
46+
            static-web-site-configuration
47+
            static-web-site-configuration?
48+
49+
            static-web-site-service-type))
50+
51+
52+
(define guix-extensions
53+
  (match (package-transitive-propagated-inputs
54+
          (specification->package "guix"))
55+
    (((labels packages) ...)
56+
     (cons (specification->package "guix") packages))))
57+
58+
(define* (build-program url root
59+
                        #:key
60+
                        (file "guix.scm")
61+
                        (ref '(branch . "master"))
62+
                        (name "build-program")
63+
                        (environment-variables '())
64+
                        (cache-directory #f))
65+
  "Return a program that pulls code from URL, builds it by loading FILE from
66+
that checkout (usually a 'guix.scm' file), and registers the result as
67+
ROOT (an indirect GC root) upon success.  FILE is loaded in a content where
68+
ENVIRONMENT-VARIABLES, a list of key/value pairs, are defined.
69+
70+
The typical use case is polling from the source repository of a web site
71+
that's built with Haunt or similar."
72+
  (define build
73+
    (with-extensions guix-extensions
74+
      #~(begin
75+
          (use-modules (guix) (guix git) (guix ui)
76+
                       (srfi srfi-11) (ice-9 match))
77+
78+
          (define (root-installed drv root)
79+
            (mbegin %store-monad
80+
              ((store-lift add-indirect-root) root)
81+
              (let ((pivot (string-append root ".tmp")))
82+
                (symlink (derivation->output-path drv) pivot)
83+
                (rename-file pivot root)
84+
                (return #t))))
85+
86+
          (define cache
87+
            (and=> #$cache-directory
88+
                   (lambda (directory)
89+
                     ;; Interpret DIRECTORY as relative to $HOME/.cache.
90+
                     (string-append (%repository-cache-directory)
91+
                                    "/" directory))))
92+
93+
          (define-values (checkout commit relation)
94+
            (apply update-cached-checkout #$url #:ref '#$ref
95+
                   (if cache
96+
                       `(#:cache-directory ,cache)
97+
                       '())))
98+
99+
          (define obj
100+
            (let ((variables '#$environment-variables))
101+
              (for-each (match-lambda
102+
                          ((name . value)
103+
                           (setenv name value)))
104+
                        variables)
105+
              (primitive-load (string-append checkout "/" #$file))))
106+
107+
          (with-store store
108+
            (run-with-store store
109+
              (mlet %store-monad ((drv (lower-object obj)))
110+
                (mbegin %store-monad
111+
                  (show-what-to-build* (list drv))
112+
                  (built-derivations (list drv))
113+
                  (root-installed drv #$root))))))))
114+
115+
  (program-file name build
116+
                #:guile guile-3.0-latest))
117+
118+

119+
;;;
120+
;;; Service.
121+
;;;
122+
123+
(define-record-type* <static-web-site-configuration>
124+
  static-web-site-configuration make-static-web-site-configuration
125+
  static-web-site-configuration?
126+
  (git-url     static-web-site-configuration-git-url)
127+
  (git-ref     static-web-site-configuration-git-ref
128+
               (default '(branch . "master")))
129+
  (build-file  static-web-site-configuration-build-file
130+
               (default "guix.scm"))
131+
  (environment-variables static-web-site-configuration-environment-variable
132+
                         (default '()))
133+
  (cache-directory static-web-site-configuration-cache-directory
134+
                   (default #f))
135+
  (directory   static-web-site-configuration-directory
136+
               (default "/srv/www")))
137+
138+
(define (static-web-site-mcron-jobs config)
139+
  (define update
140+
    (build-program (static-web-site-configuration-git-url config)
141+
                   (static-web-site-configuration-directory config)
142+
                   #:file (static-web-site-configuration-build-file config)
143+
                   #:ref (static-web-site-configuration-git-ref config)
144+
                   #:environment-variables
145+
                   (static-web-site-configuration-environment-variable config)
146+
                   #:cache-directory
147+
                   (static-web-site-configuration-cache-directory config)
148+
                   #:name (string-append
149+
                           "update-"
150+
                           (basename
151+
                            (static-web-site-configuration-directory config)))))
152+
153+
  (list #~(job '(next-minute '(0)) #$update
154+
               #:user "static-web-site")))
155+
156+
(define (static-web-site-activation config)
157+
  (with-imported-modules '((guix build utils))
158+
    #~(begin
159+
        (use-modules (guix build utils))
160+
161+
        (let ((directory (dirname
162+
                          #$(static-web-site-configuration-directory config))))
163+
          (mkdir-p directory)
164+
          (chown directory
165+
                 (passwd:uid (getpw "static-web-site"))
166+
                 (group:gid (getgr "static-web-site")))))))
167+
168+
(define (static-web-site-accounts config)
169+
  (list (user-account
170+
         (name "static-web-site")
171+
         (group "static-web-site")
172+
         (system? #t))
173+
        (user-group
174+
         (name "static-web-site")
175+
         (system? #t))))
176+
177+
(define static-web-site-service-type
178+
  (service-type (name 'static-web-site)
179+
                (extensions
180+
                 ;; TODO: Extend nginx directly from here?
181+
                 (list (service-extension mcron-service-type
182+
                                          static-web-site-mcron-jobs)
183+
                       (service-extension account-service-type
184+
                                          static-web-site-accounts)
185+
                       (service-extension activation-service-type
186+
                                          static-web-site-activation)))
187+
                (description
188+
                 "Update and publish a web site that is built from source
189+
taken from a Git repository.")))
modules/packages/gitile.scm unknown status 1
1+
;;; GNU Guix --- Functional package management for GNU
2+
;;; Copyright ?? 2020 Julien Lepiller <julien@lepiller.eu>
3+
;;;
4+
;;; This file is part of GNU Guix.
5+
;;;
6+
;;; GNU Guix is free software; you can redistribute it and/or modify it
7+
;;; under the terms of the GNU General Public License as published by
8+
;;; the Free Software Foundation; either version 3 of the License, or (at
9+
;;; your option) any later version.
10+
;;;
11+
;;; GNU Guix is distributed in the hope that it will be useful, but
12+
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13+
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14+
;;; GNU General Public License for more details.
15+
;;;
16+
;;; You should have received a copy of the GNU General Public License
17+
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
18+
;;;
19+
;;; Some of the help text was taken from the default dovecot.conf files.
20+
21+
(define-module (packages gitile)
22+
  #:use-module (gnu packages autotools)
23+
  #:use-module (gnu packages guile)
24+
  #:use-module (gnu packages guile-xyz)
25+
  #:use-module (gnu packages pkg-config)
26+
  #:use-module (gnu packages tls)
27+
  #:use-module (guix build-system gnu)
28+
  #:use-module (guix git-download)
29+
  #:use-module (guix packages)
30+
  #:use-module (guix licenses))
31+
32+
(define-public gitile
33+
  (package
34+
    (name "gitile")
35+
    (version "0.1")
36+
    (source (origin
37+
              (method git-fetch)
38+
              (uri (git-reference
39+
                     (url "https://git.lepiller.eu/git/gitile")
40+
                     (commit "e78303702bdc16fe49246a97e53b33dc47bb64de")))
41+
              (file-name (git-file-name name (string-append version "-e783037")))
42+
              (sha256
43+
               (base32
44+
                "10v5ffdlr2f1p4mf485r6p7f9vi3ypil4y70p8x1w87s5qa3dwxr"))))
45+
    (build-system gnu-build-system)
46+
    (arguments
47+
     `(#:modules ((guix build utils)
48+
                  (guix build gnu-build-system)
49+
                  (ice-9 rdelim)
50+
                  (ice-9 popen))
51+
       #:make-flags (list "GUILE_AUTO_COMPILE=0")
52+
       #:phases
53+
       (modify-phases %standard-phases
54+
         (add-after 'install 'install-bin
55+
           (lambda* (#:key outputs #:allow-other-keys)
56+
             (install-file "scripts/gitile"
57+
                           (string-append (assoc-ref outputs "out")
58+
                                          "/bin"))
59+
             #t))
60+
         (add-after 'install-bin 'wrap-program
61+
             (lambda* (#:key inputs outputs #:allow-other-keys)
62+
               ;; Wrap the 'cuirass' command to refer to the right modules.
63+
               (let* ((out    (assoc-ref outputs "out"))
64+
                      (git    (assoc-ref inputs "guile-git"))
65+
                      (bytes  (assoc-ref inputs "guile-bytestructures"))
66+
                      (fibers (assoc-ref inputs "guile-fibers"))
67+
                      (deps   (list out git bytes fibers))
68+
                      (guile  (assoc-ref %build-inputs "guile"))
69+
                      (effective (read-line
70+
                                  (open-pipe* OPEN_READ
71+
                                              (string-append guile "/bin/guile")
72+
                                              "-c" "(display (effective-version))")))
73+
                      (mods   (string-drop-right  ;drop trailing colon
74+
                               (string-join deps
75+
                                            (string-append "/share/guile/site/"
76+
                                                           effective ":")
77+
                                            'suffix)
78+
                               1))
79+
                      (objs   (string-drop-right
80+
                               (string-join deps
81+
                                            (string-append "/lib/guile/" effective
82+
                                                           "/site-ccache:")
83+
                                            'suffix)
84+
                               1)))
85+
                 (wrap-program (string-append out "/bin/gitile")
86+
                   `("GUILE_LOAD_PATH" ":" prefix (,mods))
87+
                   `("GUILE_LOAD_COMPILED_PATH" ":" prefix (,objs)))
88+
                 #t))))))
89+
    (native-inputs
90+
     `(("autoconf" ,autoconf)
91+
       ("automake" ,automake)
92+
       ("guile" ,guile-3.0)
93+
       ("pkg-config" ,pkg-config)))
94+
    (inputs
95+
     `(("guile" ,guile-3.0)
96+
       ("guile-fibers" ,guile-fibers)
97+
       ("guile-git" ,guile-git)
98+
       ("gnutls" ,gnutls)))
99+
    (home-page "")
100+
    (synopsis "")
101+
    (description "")
102+
    (license gpl3+)))
103+
104+
gitile
modules/services/gitile.scm unknown status 1
1+
;;; GNU Guix --- Functional package management for GNU
2+
;;; Copyright ?? 2020 Julien Lepiller <julien@lepiller.eu>
3+
;;;
4+
;;; This file is part of GNU Guix.
5+
;;;
6+
;;; GNU Guix is free software; you can redistribute it and/or modify it
7+
;;; under the terms of the GNU General Public License as published by
8+
;;; the Free Software Foundation; either version 3 of the License, or (at
9+
;;; your option) any later version.
10+
;;;
11+
;;; GNU Guix is distributed in the hope that it will be useful, but
12+
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13+
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14+
;;; GNU General Public License for more details.
15+
;;;
16+
;;; You should have received a copy of the GNU General Public License
17+
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
18+
;;;
19+
;;; Some of the help text was taken from the default dovecot.conf files.
20+
21+
(define-module (services gitile)
22+
  #:use-module (gnu services)
23+
  #:use-module (gnu services base)
24+
  #:use-module (gnu services configuration)
25+
  #:use-module (gnu services shepherd)
26+
  #:use-module (gnu system pam)
27+
  #:use-module (gnu system shadow)
28+
  #:use-module (gnu packages admin)
29+
  #:use-module (packages gitile)
30+
  #:use-module (guix gexp)
31+
  #:use-module (guix records)
32+
  #:use-module (ice-9 match)
33+
  #:export (gitile-service-type
34+
	    gitile-configuration))
35+
36+
(define-record-type* <gitile-configuration>
37+
  gitile-configuration make-gitile-configuration gitile-configuration?
38+
  (package gitile-configuration-package
39+
	   (default gitile))
40+
  (host gitile-configuration-host
41+
	(default "localhost"))
42+
  (port gitile-configuration-port
43+
	(default 8080))
44+
  (database gitile-configuration-database
45+
	    (default "/var/lib/gitile/gitile-db.sql"))
46+
  (repositories gitile-configuration-repositories
47+
		(default "/var/lib/gitolite/repositories")))
48+
49+
(define (gitile-config-file host port database repositories) 
50+
  (define build
51+
    #~(write `(config
52+
		(port #$port)
53+
	        (host #$host)
54+
                (database #$database)
55+
                (repositories #$repositories))
56+
	     (open-output-file #$output)))
57+
58+
  (computed-file "gitile.conf" build))
59+
60+
(define gitile-shepherd-service
61+
  (match-lambda
62+
    (($ <gitile-configuration> package host port database repositories)
63+
     (list (shepherd-service
64+
             (provision '(gitile))
65+
             (requirement '(loopback))
66+
             (documentation "gitile")
67+
             (start (let ((gitile (file-append package "/bin/gitile")))
68+
                          #~(make-forkexec-constructor
69+
                              `(,#$gitile "-c" #$(gitile-config-file
70+
						   host port database
71+
						   repositories)))))
72+
             (stop #~(make-kill-destructor)))))))
73+
74+
(define %gitile-accounts
75+
  (list (user-account
76+
          (name "gitile")
77+
          (group "git")
78+
          (system? #t)
79+
          (comment "Gitile user")
80+
          (home-directory "/var/empty")
81+
          (shell (file-append shadow "/sbin/nologin")))))
82+
83+
(define gitile-service-type
84+
  (service-type
85+
    (name 'gitile)
86+
    (extensions
87+
      (list (service-extension account-service-type
88+
                               (const %gitile-accounts))
89+
            (service-extension shepherd-root-service-type
90+
                               gitile-shepherd-service)))
91+
    (default-value
92+
      (gitile-configuration))))
systems/ene.scm
3333 
(use-modules (guix utils))
3434 
3535 
(use-modules (config certbot) (config dns) (config iptables)
36-
             (config mail) (config os))
36+
             (config mail) (config os) (config static-web)
37+
	     (services gitile) (packages gitile))
3738 
3839 
;; Copy from (gnu bootloader u-boot)
3940 
(define install-allwinner-u-boot
…
8990 
        (certbot-service `(("courriel.lepiller.eu" "imap.lepiller.eu")
9091 
                           ("ene.lepiller.eu" "rennes.lepiller.eu")
9192 
                           ("avatar.lepiller.eu")
92-
			   ("git.lepiller.eu")))
93+
                           ("git.lepiller.eu")))
9394 
        (service nginx-service-type)
9495 
        (service php-fpm-service-type)
96+
        (service fcgiwrap-service-type
97+
                 (fcgiwrap-configuration
98+
                   (group "git")))
9599 
        (cat-avatar-generator-service
96100 
          #:configuration
97101 
          (nginx-server-configuration
98102 
            (server-name '("avatar.lepiller.eu"))
99103 
            (ssl-certificate
100-
	      "/etc/letsencrypt/live/avatar.lepiller.eu/fullchain.pem")
104+
              "/etc/letsencrypt/live/avatar.lepiller.eu/fullchain.pem")
101105 
            (ssl-certificate-key
102-
	      "/etc/letsencrypt/live/avatar.lepiller.eu/privkey.pem")
106+
              "/etc/letsencrypt/live/avatar.lepiller.eu/privkey.pem")
103107 
            (listen '("443 ssl http2" "[::]:443 ssl http2"))))
104108 
        (simple-service 'default-http-server nginx-service-type
105109 
          (list (nginx-server-configuration
106110 
                  (ssl-certificate
107-
		    "/etc/letsencrypt/live/ene.lepiller.eu/fullchain.pem")
111+
                    "/etc/letsencrypt/live/ene.lepiller.eu/fullchain.pem")
108112 
                  (ssl-certificate-key
109-
		    "/etc/letsencrypt/live/ene.lepiller.eu/privkey.pem")
113+
                    "/etc/letsencrypt/live/ene.lepiller.eu/privkey.pem")
110114 
                  (listen '("443 ssl http2" "[::]:443 ssl http2"))
111115 
                  (server-name '(default))(root "/srv/http/default"))))
116+
	(service gitile-service-type)
112117 
        (simple-service 'git-server nginx-service-type
113118 
          (list (nginx-server-configuration
114119 
                  (ssl-certificate
115-
		    "/etc/letsencrypt/live/git.lepiller.eu/fullchain.pem")
120+
                    "/etc/letsencrypt/live/git.lepiller.eu/fullchain.pem")
116121 
                  (ssl-certificate-key
117-
		    "/etc/letsencrypt/live/git.lepiller.eu/privkey.pem")
122+
                    "/etc/letsencrypt/live/git.lepiller.eu/privkey.pem")
118123 
                  (listen '("443 ssl http2" "[::]:443 ssl http2"))
119-
                  (server-name '(default))(root "/srv/http/git/public"))))
120-
	(service gitolite-service-type
121-
	  (gitolite-configuration
122-
	    (admin-pubkey (local-file "../keys/tyreunom.pub")))))
124+
                  (server-name '("git.lepiller.eu"))
125+
                  (root "/srv/http/git/public")
126+
                  (locations
127+
                    (append
128+
                      (list
129+
                        (git-http-nginx-location-configuration
130+
                          (git-http-configuration
131+
                            (uri-path "/git/")
132+
                            (git-root "/var/lib/gitolite/repositories")))
133+
                        (nginx-location-configuration
134+
                          (uri "/")
135+
                          (body
136+
                            (list
137+
                              "proxy_pass http://127.0.0.1:8080/;"))))
138+
                      (map
139+
                        (lambda (loc)
140+
                          (nginx-location-configuration
141+
                            (uri loc)
142+
                            (body
143+
                              (list
144+
                                "root /srv/http/git/public;"))))
145+
                        '("/css" "/images" "~* .*/manual/.*" "= /"
146+
                          "= /index.html")))))))
147+
        (service static-web-site-service-type
148+
                 (static-web-site-configuration
149+
                  (git-url "https://git.lepiller.eu/git/guile-netlink")
150+
                  (git-ref '(branch . "master"))
151+
                  (directory "/srv/http/git/guile-netlink-manual")
152+
                  (build-file "doc/build.scm")))
153+
        ;; on activation, gitolite chmods its home directory to #o700, disabling
154+
        ;; access to git-http-backend.  Re-enable that access.
155+
        (simple-service 'gitolite-home-permissions
156+
                        activation-service-type
157+
                        #~(chmod "/var/lib/gitolite" #o750))
158+
        (service gitolite-service-type
159+
          (gitolite-configuration
160+
            (admin-pubkey (local-file "../keys/tyreunom.pub"))
161+
            (rc-file
162+
              (gitolite-rc-file
163+
                (umask #o0027)
164+
                (git-config-keys "gitweb.*"))))))
123165 
      (modify-services
124166 
        (lepiller-mail-services
125167 
          #:interface "eth0"