| 1 | |
| 2 | |
| 3 | |
| 4 | |
| 5 | |
| 6 | |
| 7 | |
| 8 | |
| 9 | |
| 10 | |
| 11 | |
| 12 | |
| 13 | |
| 14 | |
| 15 | |
| 16 | |
| 17 | |
| 18 | |
| 19 | |
| 20 | |
| 21 | |
| 22 | |
| 23 | |
| 24 | |
| 25 | |
| 26 |
|
| 27 | (define-module (gnu services version-control)
|
| 28 | #:use-module (gnu services)
|
| 29 | #:use-module (gnu services base)
|
| 30 | #:use-module (gnu services configuration)
|
| 31 | #:use-module (gnu services shepherd)
|
| 32 | #:use-module (gnu services web)
|
| 33 | #:use-module (gnu system shadow)
|
| 34 | #:use-module (gnu packages version-control)
|
| 35 | #:use-module (gnu packages admin)
|
| 36 | #:use-module (guix deprecation)
|
| 37 | #:use-module (guix packages)
|
| 38 | #:use-module (guix records)
|
| 39 | #:use-module (guix gexp)
|
| 40 | #:use-module (guix store)
|
| 41 | #:use-module (srfi srfi-1)
|
| 42 | #:use-module (srfi srfi-26)
|
| 43 | #:use-module (ice-9 format)
|
| 44 | #:use-module (ice-9 match)
|
| 45 | #:export (git-daemon-service
|
| 46 | git-daemon-service-type
|
| 47 | git-daemon-configuration
|
| 48 | git-daemon-configuration?
|
| 49 |
|
| 50 | git-http-configuration
|
| 51 | git-http-configuration?
|
| 52 | git-http-nginx-location-configuration
|
| 53 |
|
| 54 | <gitolite-configuration>
|
| 55 | gitolite-configuration
|
| 56 | gitolite-configuration-package
|
| 57 | gitolite-configuration-user
|
| 58 | gitolite-configuration-rc-file
|
| 59 | gitolite-configuration-admin-pubkey
|
| 60 | gitolite-configuration-admin-name
|
| 61 |
|
| 62 | <gitolite-rc-file>
|
| 63 | gitolite-rc-file
|
| 64 | gitolite-rc-file-local-code
|
| 65 | gitolite-rc-file-umask
|
| 66 | gitolite-rc-file-unsafe-pattern
|
| 67 | gitolite-rc-file-git-config-keys
|
| 68 | gitolite-rc-file-log-extra
|
| 69 | gitolite-rc-file-host-name
|
| 70 | gitolite-rc-file-roles
|
| 71 | gitolite-rc-file-enable
|
| 72 | gitolite-rc-file-extra-content
|
| 73 | gitolite-rc-file-default-enable
|
| 74 |
|
| 75 | <gitolite-git-configuration>
|
| 76 | gitolite-git-configuration
|
| 77 | gitolite-git-configuration?
|
| 78 | gitolite-git-configuration-name
|
| 79 | gitolite-git-configuration-email
|
| 80 | gitolite-git-configuration-default-branch
|
| 81 | gitolite-git-configuration-receive-fsck-objects
|
| 82 | gitolite-git-configuration-extra-content
|
| 83 |
|
| 84 | gitolite-service-type
|
| 85 |
|
| 86 | gitile-configuration
|
| 87 | gitile-configuration-package
|
| 88 | gitile-configuration-host
|
| 89 | gitile-configuration-port
|
| 90 | gitile-configuration-database
|
| 91 | gitile-configuration-repositories
|
| 92 | gitile-configuration-git-owner-validation?
|
| 93 | gitile-configuration-base-git-url
|
| 94 | gitile-configuration-index-title
|
| 95 | gitile-configuration-intro
|
| 96 | gitile-configuration-footer
|
| 97 | gitile-configuration-nginx
|
| 98 |
|
| 99 | gitile-service-type
|
| 100 |
|
| 101 | fossil-configuration
|
| 102 | fossil-configuration-fields
|
| 103 | fossil-configuration?
|
| 104 | fossil-configuration-package
|
| 105 | fossil-configuration-user
|
| 106 | fossil-configuration-group
|
| 107 | fossil-configuration-log-file
|
| 108 | fossil-configuration-repository
|
| 109 | fossil-configuration-acme?
|
| 110 | fossil-configuration-base-url
|
| 111 | fossil-configuration-chroot
|
| 112 | fossil-configuration-ckout-alias
|
| 113 | fossil-configuration-compress?
|
| 114 | fossil-configuration-create?
|
| 115 | fossil-configuration-error-log-file
|
| 116 | fossil-configuration-ext-root
|
| 117 | fossil-configuration-files
|
| 118 | fossil-configuration-from
|
| 119 | fossil-configuration-jail?
|
| 120 | fossil-configuration-js-mode
|
| 121 | fossil-configuration-https?
|
| 122 | fossil-configuration-ip
|
| 123 | fossil-configuration-local-authentication?
|
| 124 | fossil-configuration-main-menu
|
| 125 | fossil-configuration-max-latency
|
| 126 | fossil-configuration-port
|
| 127 | fossil-configuration-list-repositories?
|
| 128 | fossil-configuration-redirect-to-https?
|
| 129 | fossil-configuration-skin
|
| 130 | fossil-configuration-socket-file
|
| 131 | fossil-configuration-socket-mode
|
| 132 | fossil-configuration-th-trace?
|
| 133 | fossil-configuration-tls-certificate
|
| 134 | fossil-configuration-tls-private-key
|
| 135 |
|
| 136 | fossil-service-type))
|
| 137 |
|
| 138 | |
| 139 | |
| 140 | |
| 141 | |
| 142 | |
| 143 |
|
| 144 |
|
| 145 | |
| 146 | |
| 147 | |
| 148 |
|
| 149 | (define-record-type* <git-daemon-configuration>
|
| 150 | git-daemon-configuration
|
| 151 | make-git-daemon-configuration
|
| 152 | git-daemon-configuration?
|
| 153 | (package git-daemon-configuration-package |
| 154 | (default git))
|
| 155 | (export-all? git-daemon-configuration-export-all |
| 156 | (default #f))
|
| 157 | (base-path git-daemon-configuration-base-path |
| 158 | (default "/srv/git"))
|
| 159 | (user-path git-daemon-configuration-user-path |
| 160 | (default #f))
|
| 161 | (listen git-daemon-configuration-listen |
| 162 | (default '()))
|
| 163 | (port git-daemon-configuration-port |
| 164 | (default #f))
|
| 165 | (whitelist git-daemon-configuration-whitelist |
| 166 | (default '()))
|
| 167 | (extra-options git-daemon-configuration-extra-options |
| 168 | (default '())))
|
| 169 |
|
| 170 | (define git-daemon-shepherd-service
|
| 171 | (match-lambda
|
| 172 | (($ <git-daemon-configuration>
|
| 173 | package export-all? base-path user-path
|
| 174 | listen port whitelist extra-options)
|
| 175 | (let* ((git (file-append package "/bin/git"))
|
| 176 | (command `(,git
|
| 177 | "daemon" "--syslog" "--reuseaddr"
|
| 178 | ,@(if export-all?
|
| 179 | '("--export-all")
|
| 180 | '())
|
| 181 | ,@(if base-path
|
| 182 | `(,(string-append "--base-path=" base-path))
|
| 183 | '())
|
| 184 | ,@(if user-path
|
| 185 | `(,(string-append "--user-path=" user-path))
|
| 186 | '())
|
| 187 | ,@(map (cut string-append "--listen=" <>) listen)
|
| 188 | ,@(if port
|
| 189 | `(,(string-append
|
| 190 | "--port=" (number->string port)))
|
| 191 | '())
|
| 192 | ,@extra-options
|
| 193 | ,@whitelist)))
|
| 194 | (list (shepherd-service
|
| 195 | (documentation "Run the git-daemon.")
|
| 196 | (requirement '(user-processes networking))
|
| 197 | (provision '(git-daemon))
|
| 198 | (start #~(make-forkexec-constructor '#$command
|
| 199 | #:user "git-daemon"
|
| 200 | #:group "git-daemon"))
|
| 201 | (stop #~(make-kill-destructor))))))))
|
| 202 |
|
| 203 | (define %git-daemon-accounts
|
| 204 | |
| 205 | (list (user-group
|
| 206 | (name "git-daemon")
|
| 207 | (system? #t))
|
| 208 | (user-account
|
| 209 | (name "git-daemon")
|
| 210 | (system? #t)
|
| 211 | (group "git-daemon")
|
| 212 | (comment "Git daemon user")
|
| 213 | (home-directory "/var/empty")
|
| 214 | (shell (file-append shadow "/sbin/nologin")))))
|
| 215 |
|
| 216 | (define (git-daemon-activation config)
|
| 217 | "Return the activation gexp for git-daemon using CONFIG."
|
| 218 | (let ((base-path (git-daemon-configuration-base-path config)))
|
| 219 | #~(begin
|
| 220 | (use-modules (guix build utils))
|
| 221 | |
| 222 | (and=> #$base-path mkdir-p))))
|
| 223 |
|
| 224 | (define git-daemon-service-type
|
| 225 | (service-type
|
| 226 | (name 'git-daemon)
|
| 227 | (extensions
|
| 228 | (list (service-extension shepherd-root-service-type
|
| 229 | git-daemon-shepherd-service)
|
| 230 | (service-extension account-service-type
|
| 231 | (const %git-daemon-accounts))
|
| 232 | (service-extension activation-service-type
|
| 233 | git-daemon-activation)))
|
| 234 | (description
|
| 235 | "Expose Git repositories over the insecure @code{git://} TCP-based
|
| 236 | protocol.")
|
| 237 | (default-value (git-daemon-configuration))))
|
| 238 |
|
| 239 | (define-deprecated (git-daemon-service #:key (config (git-daemon-configuration)))
|
| 240 | git-daemon-service-type
|
| 241 | "Return a service that runs @command{git daemon}, a simple TCP server to
|
| 242 | expose repositories over the Git protocol for anonymous access.
|
| 243 |
|
| 244 | The optional @var{config} argument should be a
|
| 245 | @code{<git-daemon-configuration>} object, by default it allows read-only
|
| 246 | access to exported repositories under @file{/srv/git}."
|
| 247 | (service git-daemon-service-type config))
|
| 248 |
|
| 249 |
|
| 250 | |
| 251 | |
| 252 | |
| 253 | |
| 254 | |
| 255 |
|
| 256 | (define-record-type* <git-http-configuration>
|
| 257 | git-http-configuration
|
| 258 | make-git-http-configuration
|
| 259 | git-http-configuration?
|
| 260 | (package git-http-configuration-package |
| 261 | (default git))
|
| 262 | (git-root git-http-configuration-git-root |
| 263 | (default "/srv/git"))
|
| 264 | (export-all? git-http-configuration-export-all? |
| 265 | (default #f))
|
| 266 | (uri-path git-http-configuration-uri-path |
| 267 | (default "/git/"))
|
| 268 | (fcgiwrap-socket git-http-configuration-fcgiwrap-socket |
| 269 | (default "127.0.0.1:9000")))
|
| 270 |
|
| 271 | (define* (git-http-nginx-location-configuration #:optional
|
| 272 | (config
|
| 273 | (git-http-configuration)))
|
| 274 | (match config
|
| 275 | (($ <git-http-configuration> package git-root export-all?
|
| 276 | uri-path fcgiwrap-socket)
|
| 277 | (nginx-location-configuration
|
| 278 | (uri (string-append
|
| 279 | "~ "
|
| 280 | (if (string=? uri-path "/")
|
| 281 | ""
|
| 282 | (string-append "/" (string-trim-both uri-path #\/)))
|
| 283 | "(/.*)"))
|
| 284 | (body
|
| 285 | (list
|
| 286 | (list "fastcgi_pass " fcgiwrap-socket ";")
|
| 287 | (list "fastcgi_param SCRIPT_FILENAME "
|
| 288 | package "/libexec/git-core/git-http-backend"
|
| 289 | ";")
|
| 290 | "fastcgi_param QUERY_STRING $query_string;"
|
| 291 | "fastcgi_param REQUEST_METHOD $request_method;"
|
| 292 | "fastcgi_param CONTENT_TYPE $content_type;"
|
| 293 | "fastcgi_param CONTENT_LENGTH $content_length;"
|
| 294 | (if export-all?
|
| 295 | "fastcgi_param GIT_HTTP_EXPORT_ALL \"\";"
|
| 296 | "")
|
| 297 | (list "fastcgi_param GIT_PROJECT_ROOT " git-root ";")
|
| 298 | (list "fastcgi_param GIT_CONFIG_GLOBAL "
|
| 299 | (plain-file "gitconfig"
|
| 300 | (string-append "[safe]\n\tdirectory = " git-root "/*\n"))
|
| 301 | ";")
|
| 302 | "fastcgi_param PATH_INFO $1;"))))))
|
| 303 |
|
| 304 |
|
| 305 | |
| 306 | |
| 307 | |
| 308 |
|
| 309 | (define gitolite-rc-file-default-enable
|
| 310 | '("help"
|
| 311 | "desc"
|
| 312 | "info"
|
| 313 | "perms"
|
| 314 | "writable"
|
| 315 | "ssh-authkeys"
|
| 316 | "git-config"
|
| 317 | "daemon"
|
| 318 | "gitweb"))
|
| 319 |
|
| 320 | (define-record-type* <gitolite-rc-file>
|
| 321 | gitolite-rc-file make-gitolite-rc-file
|
| 322 | gitolite-rc-file?
|
| 323 | (umask gitolite-rc-file-umask
|
| 324 | (default #o0077))
|
| 325 | (local-code gitolite-rc-file-local-code
|
| 326 | (default "$rc{GL_ADMIN_BASE}/local"))
|
| 327 | (unsafe-pattern gitolite-rc-file-unsafe-pattern
|
| 328 | (default #f))
|
| 329 | (git-config-keys gitolite-rc-file-git-config-keys
|
| 330 | (default ""))
|
| 331 | (log-extra gitolite-rc-file-log-extra
|
| 332 | (default #f))
|
| 333 | (host-name gitolite-rc-file-host-name
|
| 334 | (default #f))
|
| 335 | (roles gitolite-rc-file-roles
|
| 336 | (default '(("READERS" . 1)
|
| 337 | ("WRITERS" . 1))))
|
| 338 | (enable gitolite-rc-file-enable
|
| 339 | (default gitolite-rc-file-default-enable))
|
| 340 | (extra-content gitolite-rc-extra-content
|
| 341 | (default "")))
|
| 342 |
|
| 343 | (define-gexp-compiler (gitolite-rc-file-compiler
|
| 344 | (file <gitolite-rc-file>) system target)
|
| 345 | (match-record file <gitolite-rc-file>
|
| 346 | ( umask local-code unsafe-pattern git-config-keys log-extra
|
| 347 | host-name roles enable extra-content)
|
| 348 | (apply text-file* "gitolite.rc"
|
| 349 | `("%RC = (\n"
|
| 350 | " UMASK => " ,(format #f "~4,'0o" umask) ",\n"
|
| 351 | " GIT_CONFIG_KEYS => '" ,git-config-keys "',\n"
|
| 352 | ,(if local-code
|
| 353 | (simple-format #f " LOCAL_CODE => \"~A\",\n" local-code)
|
| 354 | "")
|
| 355 | ,(if log-extra
|
| 356 | " LOG_EXTRA => 1,\n"
|
| 357 | "")
|
| 358 | ,(if host-name
|
| 359 | (simple-format #f " HOSTNAME => \"~A\",\n" host-name)
|
| 360 | "")
|
| 361 | " ROLES => {\n"
|
| 362 | ,@(map (match-lambda
|
| 363 | ((role . value)
|
| 364 | (simple-format #f " ~A => ~A,\n" role value)))
|
| 365 | roles)
|
| 366 | " },\n"
|
| 367 | "\n"
|
| 368 | " ENABLE => [\n"
|
| 369 | ,@(map (lambda (value)
|
| 370 | (simple-format #f " '~A',\n" value))
|
| 371 | enable)
|
| 372 | " ],\n"
|
| 373 | ,extra-content "\n"
|
| 374 | ");\n"
|
| 375 | "\n"
|
| 376 | ,(if unsafe-pattern
|
| 377 | (string-append "$UNSAFE_PATT = qr(" unsafe-pattern ");")
|
| 378 | "")
|
| 379 | "1;\n"
|
| 380 | "# Local variables:\n"
|
| 381 | "# mode: perl\n"
|
| 382 | "# End:\n"
|
| 383 | "# vim: set syn=perl:\n"))))
|
| 384 |
|
| 385 | (define-record-type* <gitolite-git-configuration>
|
| 386 | gitolite-git-configuration make-gitolite-git-configuration
|
| 387 | gitolite-git-configuration?
|
| 388 | (name gitolite-git-configuration-name
|
| 389 | (default "GNU Guix"))
|
| 390 | (email gitolite-git-configuration-email
|
| 391 | (default "guix@localhost"))
|
| 392 | (default-branch gitolite-git-configuration-default-branch
|
| 393 | (default #f))
|
| 394 | (receive-fsck-objects gitolite-git-configuration-receive-fsck-objects
|
| 395 | (default #f))
|
| 396 | (extra-content gitolite-git-configuration-extra-content
|
| 397 | (default "")))
|
| 398 |
|
| 399 | (define-gexp-compiler (gitolite-git-configuration-compiler
|
| 400 | (config <gitolite-git-configuration>) system target)
|
| 401 | (match-record config <gitolite-git-configuration>
|
| 402 | (name email default-branch receive-fsck-objects extra-content)
|
| 403 | (apply text-file* "gitconfig"
|
| 404 | `("[user]\n"
|
| 405 | "name = " ,name "\n"
|
| 406 | "email = " ,email "\n"
|
| 407 | ,@(if default-branch
|
| 408 | `("[init]\n"
|
| 409 | "defaultBranch = " ,default-branch "\n")
|
| 410 | '())
|
| 411 | ,@(if receive-fsck-objects
|
| 412 | `("[receive]\n"
|
| 413 | "fsckObjects = true\n")
|
| 414 | '())
|
| 415 | ,extra-content "\n"))))
|
| 416 |
|
| 417 | (define-record-type* <gitolite-configuration>
|
| 418 | gitolite-configuration make-gitolite-configuration
|
| 419 | gitolite-configuration?
|
| 420 | (package gitolite-configuration-package
|
| 421 | (default gitolite))
|
| 422 | (user gitolite-configuration-user
|
| 423 | (default "git"))
|
| 424 | (group gitolite-configuration-group
|
| 425 | (default "git"))
|
| 426 | (home-directory gitolite-configuration-home-directory
|
| 427 | (default "/var/lib/gitolite"))
|
| 428 | (rc-file gitolite-configuration-rc-file
|
| 429 | (default (gitolite-rc-file)))
|
| 430 | (git-config gitolite-configuration-git-config
|
| 431 | (default (gitolite-git-configuration)))
|
| 432 | (admin-pubkey gitolite-configuration-admin-pubkey)
|
| 433 | (admin-name gitolite-configuration-admin-name
|
| 434 | (default #f)))
|
| 435 |
|
| 436 | (define (gitolite-accounts config)
|
| 437 | (match-record config <gitolite-configuration>
|
| 438 | (user group home-directory)
|
| 439 | |
| 440 | (list (user-group
|
| 441 | (name group)
|
| 442 | (system? #t))
|
| 443 | (user-account
|
| 444 | (name user)
|
| 445 | (group group)
|
| 446 | (system? #t)
|
| 447 | (comment "Gitolite user")
|
| 448 | (home-directory home-directory)))))
|
| 449 |
|
| 450 | (define (gitolite-activation config)
|
| 451 | (match-record config <gitolite-configuration>
|
| 452 | ( package user group home-directory rc-file admin-pubkey
|
| 453 | admin-name git-config)
|
| 454 | #~(begin
|
| 455 | (use-modules (ice-9 match)
|
| 456 | (guix build utils))
|
| 457 |
|
| 458 | (let* ((user-info (getpwnam #$user))
|
| 459 | (admin-pubkey #$admin-pubkey)
|
| 460 | (pubkey-file (if #$admin-name
|
| 461 | (string-append #$admin-name ".pub")
|
| 462 | (string-append
|
| 463 | #$home-directory "/"
|
| 464 | (basename
|
| 465 | (strip-store-file-name admin-pubkey)))))
|
| 466 | (rc-file #$(string-append home-directory "/.gitolite.rc")))
|
| 467 |
|
| 468 | |
| 469 | |
| 470 | |
| 471 | |
| 472 | |
| 473 | |
| 474 | (chmod #$home-directory #o750)
|
| 475 |
|
| 476 | (simple-format #t "guix: gitolite: installing ~A\n" #$rc-file)
|
| 477 | (copy-file #$rc-file rc-file)
|
| 478 | |
| 479 | (chown rc-file
|
| 480 | (passwd:uid user-info)
|
| 481 | (passwd:gid user-info))
|
| 482 |
|
| 483 | |
| 484 | (copy-file admin-pubkey pubkey-file)
|
| 485 |
|
| 486 | (chmod pubkey-file #o500)
|
| 487 | (chown pubkey-file
|
| 488 | (passwd:uid user-info)
|
| 489 | (passwd:gid user-info))
|
| 490 |
|
| 491 | |
| 492 | |
| 493 | (copy-file #$git-config
|
| 494 | #$(string-append home-directory "/.gitconfig"))
|
| 495 |
|
| 496 | |
| 497 | |
| 498 | |
| 499 | |
| 500 | (match (primitive-fork)
|
| 501 | (0
|
| 502 | |
| 503 | (dynamic-wind
|
| 504 | (const #t)
|
| 505 | (lambda ()
|
| 506 | (setenv "HOME" (passwd:dir user-info))
|
| 507 | (setenv "USER" #$user)
|
| 508 | (setgid (passwd:gid user-info))
|
| 509 | (setuid (passwd:uid user-info))
|
| 510 | (primitive-exit
|
| 511 | (system* #$(file-append package "/bin/gitolite")
|
| 512 | "setup"
|
| 513 | "-m" "gitolite setup by GNU Guix"
|
| 514 | "-pk" pubkey-file)))
|
| 515 | (lambda ()
|
| 516 | (primitive-exit 1))))
|
| 517 | (pid (waitpid pid)))
|
| 518 |
|
| 519 | (when (file-exists? pubkey-file)
|
| 520 | (delete-file pubkey-file))))))
|
| 521 |
|
| 522 | (define gitolite-service-type
|
| 523 | (service-type
|
| 524 | (name 'gitolite)
|
| 525 | (extensions
|
| 526 | (list (service-extension activation-service-type
|
| 527 | gitolite-activation)
|
| 528 | (service-extension account-service-type
|
| 529 | gitolite-accounts)))
|
| 530 | (description
|
| 531 | "Set up @command{gitolite}, a Git hosting tool providing access over SSH.
|
| 532 | By default, the @code{git} user is used, but this is configurable.
|
| 533 | Additionally, Gitolite can integrate with with tools like gitweb or cgit to
|
| 534 | provide a web interface to view selected repositories.")))
|
| 535 |
|
| 536 | |
| 537 | |
| 538 | |
| 539 |
|
| 540 | (define-record-type* <gitile-configuration>
|
| 541 | gitile-configuration make-gitile-configuration gitile-configuration?
|
| 542 | (package gitile-configuration-package
|
| 543 | (default gitile))
|
| 544 | (host gitile-configuration-host
|
| 545 | (default "127.0.0.1"))
|
| 546 | (port gitile-configuration-port
|
| 547 | (default 8080))
|
| 548 | (database gitile-configuration-database
|
| 549 | (default "/var/lib/gitile/gitile-db.sql"))
|
| 550 | (repositories gitile-configuration-repositories
|
| 551 | (default "/var/lib/gitolite/repositories"))
|
| 552 | (git-owner-validation? gitile-configuration-git-owner-validation?
|
| 553 | (default #t))
|
| 554 | (base-git-url gitile-configuration-base-git-url)
|
| 555 | (index-title gitile-configuration-index-title
|
| 556 | (default "Index"))
|
| 557 | (intro gitile-configuration-intro
|
| 558 | (default '()))
|
| 559 | (footer gitile-configuration-footer
|
| 560 | (default '()))
|
| 561 | (nginx gitile-configuration-nginx))
|
| 562 |
|
| 563 | (define (gitile-config-file host port database repositories
|
| 564 | git-owner-validation? base-git-url
|
| 565 | index-title intro footer)
|
| 566 | (define build
|
| 567 | #~(write `(config
|
| 568 | (port #$port)
|
| 569 | (host #$host)
|
| 570 | (database #$database)
|
| 571 | (repositories #$repositories)
|
| 572 | (git-owner-validation? #$git-owner-validation?)
|
| 573 | (base-git-url #$base-git-url)
|
| 574 | (index-title #$index-title)
|
| 575 | (intro #$intro)
|
| 576 | (footer #$footer))
|
| 577 | (open-output-file #$output)))
|
| 578 |
|
| 579 | (computed-file "gitile.conf" build))
|
| 580 |
|
| 581 | (define gitile-nginx-server-block
|
| 582 | (match-lambda
|
| 583 | (($ <gitile-configuration> package host port database repositories
|
| 584 | git-owner-validation? base-git-url index-title intro footer nginx)
|
| 585 | (list (nginx-server-configuration
|
| 586 | (inherit nginx)
|
| 587 | (locations
|
| 588 | (append
|
| 589 | (list
|
| 590 | (nginx-location-configuration
|
| 591 | (uri "/")
|
| 592 | (body
|
| 593 | (list
|
| 594 | #~(string-append "proxy_pass http://" #$host
|
| 595 | ":" (number->string #$port)
|
| 596 | "/;")))))
|
| 597 | (map
|
| 598 | (lambda (loc)
|
| 599 | (nginx-location-configuration
|
| 600 | (uri loc)
|
| 601 | (body
|
| 602 | (list
|
| 603 | #~(string-append "root " #$package "/share/gitile/assets;")))))
|
| 604 | '("/css" "/js" "/images"))
|
| 605 | (nginx-server-configuration-locations nginx))))))))
|
| 606 |
|
| 607 | (define gitile-shepherd-service
|
| 608 | (match-lambda
|
| 609 | (($ <gitile-configuration> package host port database repositories
|
| 610 | git-owner-validation? base-git-url index-title intro footer nginx)
|
| 611 | (list (shepherd-service
|
| 612 | (provision '(gitile))
|
| 613 | (requirement '(loopback))
|
| 614 | (documentation "gitile")
|
| 615 | (start (let ((gitile (file-append package "/bin/gitile")))
|
| 616 | #~(make-forkexec-constructor
|
| 617 | `(,#$gitile "-c" #$(gitile-config-file
|
| 618 | host port database
|
| 619 | repositories
|
| 620 | git-owner-validation?
|
| 621 | base-git-url index-title
|
| 622 | intro footer))
|
| 623 | #:user "gitile"
|
| 624 | #:group "git")))
|
| 625 | (stop #~(make-kill-destructor)))))))
|
| 626 |
|
| 627 | (define %gitile-accounts
|
| 628 | (list (user-group
|
| 629 | (name "git")
|
| 630 | (system? #t))
|
| 631 | (user-account
|
| 632 | (name "gitile")
|
| 633 | (group "git")
|
| 634 | (system? #t)
|
| 635 | (comment "Gitile user")
|
| 636 | (home-directory "/var/empty")
|
| 637 | (shell (file-append shadow "/sbin/nologin")))))
|
| 638 |
|
| 639 | (define gitile-service-type
|
| 640 | (service-type
|
| 641 | (name 'gitile)
|
| 642 | (description "Run Gitile, a small Git forge. Expose public repositories
|
| 643 | on the web.")
|
| 644 | (extensions
|
| 645 | (list (service-extension account-service-type
|
| 646 | (const %gitile-accounts))
|
| 647 | (service-extension shepherd-root-service-type
|
| 648 | gitile-shepherd-service)
|
| 649 | (service-extension nginx-service-type
|
| 650 | gitile-nginx-server-block)))))
|
| 651 |
|
| 652 |
|
| 653 | |
| 654 | |
| 655 | |
| 656 |
|
| 657 | (define (port-number? n)
|
| 658 | (and (integer? n)
|
| 659 | (> n 0)
|
| 660 | (< n (expt 2 16))))
|
| 661 |
|
| 662 | (define (mode-number? n)
|
| 663 | (and (integer? n)
|
| 664 | (>= n 0)
|
| 665 | (<= n #o777)))
|
| 666 |
|
| 667 | (define (fossil-js-mode? x)
|
| 668 | (and (memq x '(inline separate bundled))
|
| 669 | #t))
|
| 670 |
|
| 671 | (define-maybe/no-serialization number)
|
| 672 | (define-maybe/no-serialization string)
|
| 673 | (define-maybe/no-serialization list-of-strings)
|
| 674 | (define-maybe/no-serialization fossil-js-mode)
|
| 675 |
|
| 676 | (define-configuration/no-serialization fossil-configuration
|
| 677 | (package (package fossil)
|
| 678 | "The Fossil package to use.")
|
| 679 | (user (string "fossil")
|
| 680 | "The user running the Fossil server.")
|
| 681 | (group (string "fossil")
|
| 682 | "The user group running the Fossil server.")
|
| 683 | (log-file (string "/var/log/fossil.log")
|
| 684 | "The path to the server's log.")
|
| 685 | (repository (string "/var/lib/fossil")
|
| 686 | "The name of the Fossil repository to be served, or a directory
|
| 687 | containing one or more repositories with names ending in @code{.fossil}.
|
| 688 |
|
| 689 | In the latter case, a prefix of the URL pathname is used
|
| 690 | to search the directory for an appropriate repository.
|
| 691 | Files not matching the pattern @code{*.fossil*}
|
| 692 | will be served as static content. Invoke @command{fossil server --help}
|
| 693 | for more information.")
|
| 694 | (acme? (boolean #f)
|
| 695 | "Deliver files from the @code{.well-known} subdirectory.")
|
| 696 | (base-url maybe-string
|
| 697 | "The URL used as the base (useful for reverse proxies)")
|
| 698 | (chroot maybe-string
|
| 699 | "The directory to use for chroot instead of @code{repository}.")
|
| 700 | (ckout-alias maybe-string
|
| 701 | "The @var{name} for @code{/doc/@var{name}/...}
|
| 702 | to be treated as @code{/doc/ckout/...}.")
|
| 703 | (compress? (boolean #t) "Compress HTTP response.")
|
| 704 | (create? (boolean #f)
|
| 705 | "Create a new @code{repository} if it does not already exist.")
|
| 706 | (error-log-file maybe-string "The path for HTTP error log.")
|
| 707 | (ext-root maybe-string "The document root for the /ext extension mechanism.")
|
| 708 | (files maybe-list-of-strings "The glob patterns for static files.")
|
| 709 | (from maybe-string
|
| 710 | "The path to be used as the diff baseline for the /ckout page.")
|
| 711 | (jail? (boolean #t)
|
| 712 | "Whether to enter the chroot jail after dropping root privileges.")
|
| 713 | (js-mode maybe-fossil-js-mode
|
| 714 | "How JavaScript is delivered with pages, either @code{'inline}
|
| 715 | at the end of the HTML file, as @code{'separate} HTTP requests,
|
| 716 | or one single HTTP request for all JavaScript @code{'bundled} together.
|
| 717 |
|
| 718 | Depending on the needs of any given page, @code{'inline}
|
| 719 | and @code{'bundled} modes might result in a single amalgamated script
|
| 720 | or several, but both approaches result in fewer HTTP requests
|
| 721 | than the @code{'separate} mode.")
|
| 722 | (https? (boolean #f)
|
| 723 | "Indicate that the requests are coming through a reverse proxy
|
| 724 | that has already translated HTTPS into HTTP.")
|
| 725 | (ip maybe-string "The IP for the server to listen on.")
|
| 726 | (local-authentication? (boolean #f)
|
| 727 | "Enable automatic login for requests from localhost.")
|
| 728 | (localhost? (boolean #f) "Listen on @code{127.0.0.1} only.")
|
| 729 | (main-menu maybe-string |
| 730 | "The file whose contents is to override
|
| 731 | the repository's @code{mainmenu} setting.")
|
| 732 | (max-latency maybe-number
|
| 733 | "The maximum latency in seconds for a single HTTP request.")
|
| 734 | (port (port-number 8080) "The port number for the server to listen on.")
|
| 735 | (list-repositories? (boolean #f)
|
| 736 | "If @code{repository} is dir, URL @code{/} lists repos.")
|
| 737 | (redirect-to-https? (boolean #t)
|
| 738 | "If set to @code{#f}, do not force redirects to HTTPS
|
| 739 | regardless of the repository setting @code{redirect-to-https}.")
|
| 740 | (scgi? (boolean #f) "Accept SCGI rather than HTTP.")
|
| 741 | (skin maybe-string "The skin label to use, overriding repository settings.")
|
| 742 | (socket-file maybe-string
|
| 743 | "The unix-domain socket to use instead of TCP/IP.")
|
| 744 | (socket-mode (mode-number #o640)
|
| 745 | "The file permissions to set for the unix socket.")
|
| 746 | (th-trace? (boolean #f)
|
| 747 | "Trace TH1 execution (for debugging purposes).")
|
| 748 | (tls-certificate maybe-string
|
| 749 | "The certicate file (@file{fullchain.pem})
|
| 750 | with which to enable TLS (HTTPS) encryption.")
|
| 751 | (tls-private-key maybe-string "The file storing the TLS private key."))
|
| 752 |
|
| 753 | (define (fossil-accounts config)
|
| 754 | (match-record config <fossil-configuration> (user group)
|
| 755 | (list (user-group (name group)
|
| 756 | (system? #t))
|
| 757 | (user-account (name user)
|
| 758 | (group group)
|
| 759 | (system? #t)
|
| 760 | (comment "Fossil server user")
|
| 761 | (home-directory "/var/empty")
|
| 762 | (shell (file-append shadow "/sbin/nologin"))))))
|
| 763 |
|
| 764 | (define (fossil-activation config)
|
| 765 | (match-record config <fossil-configuration> (user create? repository)
|
| 766 | (with-imported-modules '((guix build utils))
|
| 767 | #~(begin
|
| 768 | (use-modules (guix build utils))
|
| 769 | (let* ((pw (getpwnam #$user))
|
| 770 | (uid (passwd:uid pw))
|
| 771 | (gid (passwd:gid pw)))
|
| 772 | (unless #$create? (chown #$repository uid gid)))))))
|
| 773 |
|
| 774 | (define (fossil-shepherd-service config)
|
| 775 | (match-record config <fossil-configuration>
|
| 776 | (package user group log-file repository acme? base-url
|
| 777 | chroot ckout-alias compress? create? error-log-file ext-root
|
| 778 | files from https? ip jail? js-mode list-repositories?
|
| 779 | local-authentication? localhost? main-menu max-latency port
|
| 780 | redirect-to-https? scgi? skin socket-file socket-mode
|
| 781 | th-trace? tls-certificate tls-private-key)
|
| 782 | (shepherd-service
|
| 783 | (provision '(fossil))
|
| 784 | (requirement '(user-processes networking))
|
| 785 | (start #~(make-forkexec-constructor
|
| 786 | (list #$(file-append package "/bin/fossil")
|
| 787 | "server"
|
| 788 | #$@(if acme? '("--acme") '())
|
| 789 | #$@(if (maybe-value-set? base-url)
|
| 790 | (list "--baseurl" base-url)
|
| 791 | '())
|
| 792 | #$@(if (maybe-value-set? chroot)
|
| 793 | (list "--chroot" chroot)
|
| 794 | '())
|
| 795 | #$@(if (maybe-value-set? ckout-alias)
|
| 796 | (list "--ckout-alias" ckout-alias)
|
| 797 | '())
|
| 798 | #$@(if compress? '() '("--nocompress"))
|
| 799 | #$@(if create? '("--create") '())
|
| 800 | #$@(if (maybe-value-set? error-log-file)
|
| 801 | (list "--errorlog" error-log-file)
|
| 802 | '())
|
| 803 | #$@(if (maybe-value-set? ext-root)
|
| 804 | (list "--extroot" ext-root)
|
| 805 | '())
|
| 806 | #$@(if (maybe-value-set? files)
|
| 807 | (list "--files" (string-join files ","))
|
| 808 | '())
|
| 809 | #$@(if (maybe-value-set? from) (list "--from" from) '())
|
| 810 | #$@(if https? '("--https") '())
|
| 811 | #$@(if jail? '() '("--nojail"))
|
| 812 | #$@(if (maybe-value-set? js-mode)
|
| 813 | (list "--jsmode" (symbol->string js-mode))
|
| 814 | '())
|
| 815 | #$@(if local-authentication? '("--localauth") '())
|
| 816 | #$@(if localhost? '("--localhost") '())
|
| 817 | #$@(if (maybe-value-set? main-menu)
|
| 818 | (list "--mainmenu" main-menu)
|
| 819 | '())
|
| 820 | #$@(if (maybe-value-set? max-latency)
|
| 821 | (list "--max-latency"
|
| 822 | (number->string max-latency))
|
| 823 | '())
|
| 824 | #$@(if redirect-to-https? '() '("--nossl"))
|
| 825 | #$@(if scgi? '("--scgi") '())
|
| 826 | #$@(if list-repositories? '("--repolist") '())
|
| 827 | #$@(if (maybe-value-set? skin) (list "--skin" skin) '())
|
| 828 | #$@(if (maybe-value-set? socket-file)
|
| 829 | (list "--socket-name" socket-file
|
| 830 | "--socket-mode" socket-mode
|
| 831 | "--socket-owner"
|
| 832 | (simple-format #f "~a:~a" user group))
|
| 833 | (list "--port"
|
| 834 | (if (maybe-value-set? ip)
|
| 835 | (simple-format #f "~a:~a" ip port)
|
| 836 | (number->string port))))
|
| 837 | #$@(if th-trace? '("--th-trace") '())
|
| 838 | #$@(if (maybe-value-set? tls-certificate)
|
| 839 | (list "--cert" tls-certificate)
|
| 840 | '())
|
| 841 | #$@(if (maybe-value-set? tls-private-key)
|
| 842 | (list "--pkey" tls-private-key)
|
| 843 | '())
|
| 844 | "--user" #$user
|
| 845 | #$repository)
|
| 846 | #:user #$user
|
| 847 | #:group #$group
|
| 848 | #:log-file #$log-file))
|
| 849 | (stop #~(make-kill-destructor))
|
| 850 | (documentation
|
| 851 | "Run the HTTP server
|
| 852 | for the Fossil software configuration management system."))))
|
| 853 |
|
| 854 | (define fossil-service-type
|
| 855 | (service-type
|
| 856 | (name 'fossil)
|
| 857 | (extensions
|
| 858 | (list (service-extension account-service-type fossil-accounts)
|
| 859 | (service-extension activation-service-type fossil-activation)
|
| 860 | (service-extension shepherd-root-service-type
|
| 861 | (compose list fossil-shepherd-service))))
|
| 862 | (description
|
| 863 | "Run the HTTP server for the Fossil software configuration management
|
| 864 | system. In addition to distributed version control, Fossil also supports
|
| 865 | bug tracking, wiki, forum, email alerts, chat, and technotes.")))
|