;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is>
;;;
;;; 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 system shadow)
  #:use-module (gnu packages version-control)
  #:use-module (gnu packages admin)
  #:use-module (guix records)
  #:use-module (guix gexp)
  #:use-module (srfi srfi-1)
  #:use-module (ice-9 match)
  #:export (git-service
            git-service-type
            git-configuration
            git-configuration?
            git-configuration-git
            git-configuration-port
            git-configuration-base-directory
            git-configuration-pid-file
            git-configuration-max-connections
            git-configuration-user-directory
            git-configuration-directory))

;;; Commentary:
;;;
;;; Version Control related services.
;;;
;;; Code:


;;;
;;; git
;;;

(define-record-type* <git-configuration> git-configuration
  make-git-configuration
  git-configuration?
  (git              git-configuration-git  ;package
                    (default git))
  (pid-file?        git-configuration-pid-file) ;string
  (base-directory   git-configuration-base-directory) ;string
  (user-directory?  git-configuration-user-directory) ;string
  (directory?       git-configuration-directory) ;string
  (max-connections  git-configuration-max-connections) ;number
  (port             git-configuration-port)) ;number

(define (git-shepherd-service config)
  "Return a <shepherd-service> for git with CONFIG."
  (define git (git-configuration-git config))

  (define git-command
    #~(list
       (string-append #$git "/bin/git") "daemon" "--syslog" "--user=git"
       "--group=git" "--no-informative-errors" "--reuseaddr"
       ;; A directory to add to the whitelist of allowed directories. Unless
       ;; --strict-paths is specified this will also include subdirectories of
       ;; each named directory.
       ;; --directory
       ;; TODO: Add the option to add multiple occurences of --directory
       (if (git-configuration-directory? config)
           (string-append "--directory=" #$(git-configuration-directory config))
           "")
       ;; --interpolated-path=<pathtemplate>
       ;; To support virtual hosting, an interpolated path template can be used to
       ;; dynamically construct alternate paths. The template supports %H for the target
       ;; hostname as supplied by the client but converted to all lowercase,
       ;; %CH for the canonical hostname, %IP for the server’s IP address,
       ;; %P for the port number, and %D for the absolute path of the named repository.
       ;; After interpolation, the path is validated against the directory whitelist.

       ;; --listen=<host_or_ipaddr>
       ;; Listen on a specific IP address or hostname. IP addresses can be either an IPv4
       ;; address or an IPv6 address if supported. If IPv6 is not supported, then
       ;; --listen=hostname is also not supported and --listen must be given an IPv4 address.
       ;; Can be given more than once. Incompatible with --inetd option.

       ;; Maximum number of concurrent clients, defaults to 32. Set it to zero for no limit.
       (string-append "--max-connections=" #$(number->string
                                              (git-configuration-max-connections config)))

       ;; --user-path, --user-path=<path>
       ;; Allow ~user notation to be used in requests. When specified with no parameter,
       ;; requests to git://host/~alice/foo is taken as a request to access foo repository
       ;; in the home directory of user alice. If --user-path=path is specified, the same
       ;; request is taken as a request to access path/foo repository in the home
       ;; directory of user alice.
       (if (git-configuration-user-directory? config)
           "--user-path" "")

       ;; Save the process id in file.
       (if (git-configuration-pid-file? config)
           (string-append "--pid-file=" #$(git-configuration-pid-file config))
           "")
       (string-append "--port=" #$(number->string (git-configuration-port config)))
       (string-append "--base-path=" #$(git-configuration-base-directory config))))

  (define requires '(networking syslogd))

  (list (shepherd-service
         (documentation "Git daemon server for git repositories")
         (requirement requires)
         (provision '(git))
         (start #~(make-forkexec-constructor #$git-command))
         (stop #~(make-kill-destructor)))))

(define %git-accounts
  ;; User account and groups for git-daemon.
  (list (user-group
         (name "git")
         (system? #t))
        (user-account
         (name "git")
         (system? #t)
         (group "git")
         (comment "Shepherd created user for the git-daemon service")
         ;; (home-directory "/var/empty")
         (home-directory "/var/git")
         ;;(shell #~(string-append #$shadow "/sbin/nologin")))))
         (shell #~(string-append #$shadow "/bin/git-shell")))))

(define (git-activation config)
  "Return the activation GEXP for CONFIG."
  #~(begin
      (use-modules (guix build utils))
      (let ((user (getpwnam "git")))
        (mkdir-p (dirname #$(git-configuration-pid-file config)))
        (mkdir-p (dirname #$(git-configuration-base-directory config)))
        (chown (dirname #$(git-configuration-base-directory config))
               (passwd:uid user) (passwd:gid user)))))

(define git-service-type
  (service-type (name 'git)
   (extensions
    (list (service-extension shepherd-root-service-type
                             git-shepherd-service)
          (service-extension activation-service-type
                             git-activation)))))

(define* (git-service #:key (config (git-configuration)))
  "Return a service that runs @url{https://git-scm.org,git} as a daemon.
The daemon will listen on the port specified in @var{port}.
In addition, @var{base-path} specifies the path which will repositories
which can be exported by adding 'git-daemon-export-ok' files to them."
  (service git-service-type config))