3
5
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00
guix/gnu/services/version-control.scm
ng0 4a78fd4617
Correct name and Email for ng0.
* .mailmap: Correct name and Email for ng0.
* Makefile.am, doc/guix.texi, etc/completion/fish/guix.fish
gnu/packages/accessibility.scm, gnu/packages/admin.scm,
gnu/packages/audio.scm, gnu/packages/autotools.scm,
gnu/packages/cdrom.scm, gnu/packages/check.scm,
gnu/packages/cinnamon.scm, gnu/packages/compression.scm,
gnu/packages/crypto.scm, gnu/packages/databases.scm,
gnu/packages/django.scm, gnu/packages/dns.scm,
gnu/packages/emacs.scm, gnu/packages/enlightenment.scm,
gnu/packages/fonts.scm, gnu/packages/fontutils.scm,
gnu/packages/forth.scm, gnu/packages/fvwm.scm,
gnu/packages/games.scm, gnu/packages/gl.scm,
gnu/packages/gnome.scm, gnu/packages/gnunet.scm,
gnu/packages/gnupg.scm, gnu/packages/gnuzilla.scm,
gnu/packages/gtk.scm, gnu/packages/guile-wm.scm,
gnu/packages/guile.scm, gnu/packages/haskell-check.scm,
gnu/packages/haskell-crypto.scm, gnu/packages/haskell.scm,
gnu/packages/image-viewers.scm, gnu/packages/image.scm,
gnu/packages/irc.scm, gnu/packages/language.scm,
gnu/packages/libcanberra.scm, gnu/packages/linux.scm,
gnu/packages/lisp.scm, gnu/packages/lolcode.scm,
gnu/packages/lxde.scm, gnu/packages/lxqt.scm,
gnu/packages/mail.scm, gnu/packages/markup.scm,
gnu/packages/mate.scm, gnu/packages/maths.scm,
gnu/packages/mc.scm, gnu/packages/messaging.scm,
gnu/packages/music.scm, gnu/packages/ncurses.scm,
gnu/packages/networking.scm, gnu/packages/nickle.scm,
gnu/packages/openbox.scm, gnu/packages/pdf.scm,
gnu/packages/perl-check.scm, gnu/packages/perl.scm,
gnu/packages/python-crypto.scm, gnu/packages/python-web.scm,
gnu/packages/python.scm, gnu/packages/qt.scm,
gnu/packages/ruby.scm, gnu/packages/rust.scm,
gnu/packages/scheme.scm, gnu/packages/serialization.scm,
gnu/packages/shells.scm, gnu/packages/ssh.scm,
gnu/packages/suckless.scm, gnu/packages/tbb.scm,
gnu/packages/telephony.scm, gnu/packages/text-editors.scm,
gnu/packages/textutils.scm, gnu/packages/time.scm,
gnu/packages/tls.scm, gnu/packages/tor.scm,
gnu/packages/version-control.scm, gnu/packages/video.scm,
gnu/packages/vim.scm, gnu/packages/web.scm,
gnu/packages/wm.scm, gnu/packages/xdisorg.scm,
gnu/packages/xfce.scm, gnu/packages/xml.scm,
gnu/packages/xorg.scm, gnu/services/certbot.scm,
gnu/services/desktop.scm, gnu/services/version-control.scm,
gnu/services/web.scm, guix/import/hackage.scm,
guix/licenses.scm: Likewise.

Signed-off-by: Tobias Geerinckx-Rice <me@tobias.gr>
2018-03-20 17:17:58 +01:00

199 lines
7.7 KiB
Scheme
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Nils Gillmann <ng0@n0.is>
;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org>
;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services version-control)
#:use-module (gnu services)
#:use-module (gnu services base)
#:use-module (gnu services shepherd)
#:use-module (gnu services web)
#:use-module (gnu system shadow)
#:use-module (gnu packages version-control)
#:use-module (gnu packages admin)
#:use-module (guix records)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:export (git-daemon-service
git-daemon-service-type
git-daemon-configuration
git-daemon-configuration?
git-http-configuration
git-http-configuration?
git-http-nginx-location-configuration))
;;; Commentary:
;;;
;;; Version Control related services.
;;;
;;; Code:
;;;
;;; Git daemon.
;;;
(define-record-type* <git-daemon-configuration>
git-daemon-configuration
make-git-daemon-configuration
git-daemon-configuration?
(package git-daemon-configuration-package ;package
(default git))
(export-all? git-daemon-configuration-export-all ;boolean
(default #f))
(base-path git-daemon-configuration-base-path ;string | #f
(default "/srv/git"))
(user-path git-daemon-configuration-user-path ;string | #f
(default #f))
(listen git-daemon-configuration-listen ;list of string
(default '()))
(port git-daemon-configuration-port ;number | #f
(default #f))
(whitelist git-daemon-configuration-whitelist ;list of string
(default '()))
(extra-options git-daemon-configuration-extra-options ;list of string
(default '())))
(define git-daemon-shepherd-service
(match-lambda
(($ <git-daemon-configuration>
package export-all? base-path user-path
listen port whitelist extra-options)
(let* ((git (file-append package "/bin/git"))
(command `(,git
"daemon" "--syslog" "--reuseaddr"
,@(if export-all?
'("--export-all")
'())
,@(if base-path
`(,(string-append "--base-path=" base-path))
'())
,@(if user-path
`(,(string-append "--user-path=" user-path))
'())
,@(map (cut string-append "--listen=" <>) listen)
,@(if port
`(,(string-append
"--port=" (number->string port)))
'())
,@extra-options
,@whitelist)))
(list (shepherd-service
(documentation "Run the git-daemon.")
(requirement '(networking))
(provision '(git-daemon))
(start #~(make-forkexec-constructor '#$command
#:user "git-daemon"
#:group "git-daemon"))
(stop #~(make-kill-destructor))))))))
(define %git-daemon-accounts
;; User account and group for git-daemon.
(list (user-group
(name "git-daemon")
(system? #t))
(user-account
(name "git-daemon")
(system? #t)
(group "git-daemon")
(comment "Git daemon user")
(home-directory "/var/empty")
(shell (file-append shadow "/sbin/nologin")))))
(define (git-daemon-activation config)
"Return the activation gexp for git-daemon using CONFIG."
(let ((base-path (git-daemon-configuration-base-path config)))
#~(begin
(use-modules (guix build utils))
;; Create the 'base-path' directory when it's not '#f'.
(and=> #$base-path mkdir-p))))
(define git-daemon-service-type
(service-type
(name 'git-daemon)
(extensions
(list (service-extension shepherd-root-service-type
git-daemon-shepherd-service)
(service-extension account-service-type
(const %git-daemon-accounts))
(service-extension activation-service-type
git-daemon-activation)))
(description
"Expose Git respositories over the insecure @code{git://} TCP-based
protocol.")
(default-value (git-daemon-configuration))))
(define* (git-daemon-service #:key (config (git-daemon-configuration)))
"Return a service that runs @command{git daemon}, a simple TCP server to
expose repositories over the Git protocol for annoymous access.
The optional @var{config} argument should be a
@code{<git-daemon-configuration>} object, by default it allows read-only
access to exported repositories under @file{/srv/git}."
(service git-daemon-service-type config))
;;;
;;; HTTP access. Add the result of calling
;;; git-http-nginx-location-configuration to an nginx-server-configuration's
;;; "locations" field.
;;;
(define-record-type* <git-http-configuration>
git-http-configuration
make-git-http-configuration
git-http-configuration?
(package git-http-configuration-package ;package
(default git))
(git-root git-http-configuration-git-root ;string
(default "/srv/git"))
(export-all? git-http-configuration-export-all? ;boolean
(default #f))
(uri-path git-http-configuration-uri-path ;string
(default "/git/"))
(fcgiwrap-socket git-http-configuration-fcgiwrap-socket ;string
(default "127.0.0.1:9000")))
(define* (git-http-nginx-location-configuration #:optional
(config
(git-http-configuration)))
(match config
(($ <git-http-configuration> package git-root export-all?
uri-path fcgiwrap-socket)
(nginx-location-configuration
(uri (string-append "~ /" (string-trim-both uri-path #\/) "(/.*)"))
(body
(list
(list "fastcgi_pass " fcgiwrap-socket ";")
(list "fastcgi_param SCRIPT_FILENAME "
package "/libexec/git-core/git-http-backend"
";")
"fastcgi_param QUERY_STRING $query_string;"
"fastcgi_param REQUEST_METHOD $request_method;"
"fastcgi_param CONTENT_TYPE $content_type;"
"fastcgi_param CONTENT_LENGTH $content_length;"
(if export-all?
"fastcgi_param GIT_HTTP_EXPORT_ALL \"\";"
"")
(list "fastcgi_param GIT_PROJECT_ROOT " git-root ";")
"fastcgi_param PATH_INFO $1;"))))))