diff options
| author | Mark H Weaver <mhw@netris.org> | 2018-09-29 21:18:45 -0400 |
|---|---|---|
| committer | Mark H Weaver <mhw@netris.org> | 2018-09-29 21:18:45 -0400 |
| commit | 17bea1803cf706d8db053d8d73302a4455684d29 (patch) | |
| tree | 073d30a8ff065d4e08cc4901f7e97e72a9de68a6 /gnu | |
| parent | e72ca4111fce4b05bf2a685e451f26e06680e36c (diff) | |
Revert "services: Add Gitolite."
This reverts commit 258a6d944ed891fa92fa87a16731e5dfe0bac477.
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/services/version-control.scm | 179 | ||||
| -rw-r--r-- | gnu/tests/version-control.scm | 114 |
2 files changed, 2 insertions, 291 deletions
diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm index cc8cd220211..58274c8beed 100644 --- a/gnu/services/version-control.scm +++ b/gnu/services/version-control.scm | |||
| @@ -3,7 +3,6 @@ | |||
| 3 | ;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org> | 3 | ;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org> |
| 4 | ;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com> | 4 | ;;; Copyright © 2017 Oleg Pykhalov <go.wigust@gmail.com> |
| 5 | ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> | 5 | ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> |
| 6 | ;;; Copyright © 2018 Christopher Baines <mail@cbaines.net> | ||
| 7 | ;;; | 6 | ;;; |
| 8 | ;;; This file is part of GNU Guix. | 7 | ;;; This file is part of GNU Guix. |
| 9 | ;;; | 8 | ;;; |
| @@ -41,23 +40,7 @@ | |||
| 41 | 40 | ||
| 42 | git-http-configuration | 41 | git-http-configuration |
| 43 | git-http-configuration? | 42 | git-http-configuration? |
| 44 | git-http-nginx-location-configuration | 43 | git-http-nginx-location-configuration)) |
| 45 | |||
| 46 | <gitolite-configuration> | ||
| 47 | gitolite-configuration | ||
| 48 | gitolite-configuration-package | ||
| 49 | gitolite-configuration-user | ||
| 50 | gitolite-configuration-rc-file | ||
| 51 | gitolite-configuration-admin-pubkey | ||
| 52 | |||
| 53 | <gitolite-rc-file> | ||
| 54 | gitolite-rc-file | ||
| 55 | gitolite-rc-file-umask | ||
| 56 | gitolite-rc-file-git-config-keys | ||
| 57 | gitolite-rc-file-roles | ||
| 58 | gitolite-rc-file-enable | ||
| 59 | |||
| 60 | gitolite-service-type)) | ||
| 61 | 44 | ||
| 62 | ;;; Commentary: | 45 | ;;; Commentary: |
| 63 | ;;; | 46 | ;;; |
| @@ -214,163 +197,3 @@ access to exported repositories under @file{/srv/git}." | |||
| 214 | "") | 197 | "") |
| 215 | (list "fastcgi_param GIT_PROJECT_ROOT " git-root ";") | 198 | (list "fastcgi_param GIT_PROJECT_ROOT " git-root ";") |
| 216 | "fastcgi_param PATH_INFO $1;")))))) | 199 | "fastcgi_param PATH_INFO $1;")))))) |
| 217 | |||
| 218 | |||
| 219 | ;;; | ||
| 220 | ;;; Gitolite | ||
| 221 | ;;; | ||
| 222 | |||
| 223 | (define-record-type* <gitolite-rc-file> | ||
| 224 | gitolite-rc-file make-gitolite-rc-file | ||
| 225 | gitolite-rc-file? | ||
| 226 | (umask gitolite-rc-file-umask | ||
| 227 | (default #o0077)) | ||
| 228 | (git-config-keys gitolite-rc-file-git-config-keys | ||
| 229 | (default "")) | ||
| 230 | (roles gitolite-rc-file-roles | ||
| 231 | (default '(("READERS" . 1) | ||
| 232 | ("WRITERS" . 1)))) | ||
| 233 | (enable gitolite-rc-file-enable | ||
| 234 | (default '("help" | ||
| 235 | "desc" | ||
| 236 | "info" | ||
| 237 | "perms" | ||
| 238 | "writable" | ||
| 239 | "ssh-authkeys" | ||
| 240 | "git-config" | ||
| 241 | "daemon" | ||
| 242 | "gitweb")))) | ||
| 243 | |||
| 244 | (define-gexp-compiler (gitolite-rc-file-compiler | ||
| 245 | (file <gitolite-rc-file>) system target) | ||
| 246 | (match file | ||
| 247 | (($ <gitolite-rc-file> umask git-config-keys roles enable) | ||
| 248 | (apply text-file* "gitolite.rc" | ||
| 249 | `("%RC = (\n" | ||
| 250 | " UMASK => " ,(format #f "~4,'0o" umask) ",\n" | ||
| 251 | " GIT_CONFIG_KEYS => '" ,git-config-keys "',\n" | ||
| 252 | " ROLES => {\n" | ||
| 253 | ,@(map (match-lambda | ||
| 254 | ((role . value) | ||
| 255 | (simple-format #f " ~A => ~A,\n" role value))) | ||
| 256 | roles) | ||
| 257 | " },\n" | ||
| 258 | "\n" | ||
| 259 | " ENABLE => [\n" | ||
| 260 | ,@(map (lambda (value) | ||
| 261 | (simple-format #f " '~A',\n" value)) | ||
| 262 | enable) | ||
| 263 | " ],\n" | ||
| 264 | ");\n" | ||
| 265 | "\n" | ||
| 266 | "1;\n"))))) | ||
| 267 | |||
| 268 | (define-record-type* <gitolite-configuration> | ||
| 269 | gitolite-configuration make-gitolite-configuration | ||
| 270 | gitolite-configuration? | ||
| 271 | (package gitolite-configuration-package | ||
| 272 | (default gitolite)) | ||
| 273 | (user gitolite-configuration-user | ||
| 274 | (default "git")) | ||
| 275 | (group gitolite-configuration-group | ||
| 276 | (default "git")) | ||
| 277 | (home-directory gitolite-configuration-home-directory | ||
| 278 | (default "/var/lib/gitolite")) | ||
| 279 | (rc-file gitolite-configuration-rc-file | ||
| 280 | (default (gitolite-rc-file))) | ||
| 281 | (admin-pubkey gitolite-configuration-admin-pubkey)) | ||
| 282 | |||
| 283 | (define gitolite-accounts | ||
| 284 | (match-lambda | ||
| 285 | (($ <gitolite-configuration> package user group home-directory | ||
| 286 | rc-file admin-pubkey) | ||
| 287 | ;; User group and account to run Gitolite. | ||
| 288 | (list (user-group (name user) (system? #t)) | ||
| 289 | (user-account | ||
| 290 | (name user) | ||
| 291 | (group group) | ||
| 292 | (system? #t) | ||
| 293 | (comment "Gitolite user") | ||
| 294 | (home-directory home-directory)))))) | ||
| 295 | |||
| 296 | (define gitolite-activation | ||
| 297 | (match-lambda | ||
| 298 | (($ <gitolite-configuration> package user group home | ||
| 299 | rc-file admin-pubkey) | ||
| 300 | #~(begin | ||
| 301 | (use-modules (ice-9 match) | ||
| 302 | (guix build utils)) | ||
| 303 | |||
| 304 | (let* ((user-info (getpwnam #$user)) | ||
| 305 | (admin-pubkey #$admin-pubkey) | ||
| 306 | (pubkey-file (string-append | ||
| 307 | #$home "/" | ||
| 308 | (basename | ||
| 309 | (strip-store-file-name admin-pubkey))))) | ||
| 310 | |||
| 311 | (simple-format #t "guix: gitolite: installing ~A\n" #$rc-file) | ||
| 312 | (copy-file #$rc-file #$(string-append home "/.gitolite.rc")) | ||
| 313 | |||
| 314 | ;; The key must be writable, so copy it from the store | ||
| 315 | (copy-file admin-pubkey pubkey-file) | ||
| 316 | |||
| 317 | (chmod pubkey-file #o500) | ||
| 318 | (chown pubkey-file | ||
| 319 | (passwd:uid user-info) | ||
| 320 | (passwd:gid user-info)) | ||
| 321 | |||
| 322 | ;; Set the git configuration, to avoid gitolite trying to use | ||
| 323 | ;; the hostname command, as the network might not be up yet | ||
| 324 | (with-output-to-file #$(string-append home "/.gitconfig") | ||
| 325 | (lambda () | ||
| 326 | (display "[user] | ||
| 327 | name = GNU Guix | ||
| 328 | email = guix@localhost | ||
| 329 | "))) | ||
| 330 | ;; Run Gitolite setup, as this updates the hooks and include the | ||
| 331 | ;; admin pubkey if specified. The admin pubkey is required for | ||
| 332 | ;; initial setup, and will replace the previous key if run after | ||
| 333 | ;; initial setup | ||
| 334 | (match (primitive-fork) | ||
| 335 | (0 | ||
| 336 | ;; Exit with a non-zero status code if an exception is thrown. | ||
| 337 | (dynamic-wind | ||
| 338 | (const #t) | ||
| 339 | (lambda () | ||
| 340 | (setenv "HOME" (passwd:dir user-info)) | ||
| 341 | (setenv "USER" #$user) | ||
| 342 | (setgid (passwd:gid user-info)) | ||
| 343 | (setuid (passwd:uid user-info)) | ||
| 344 | (primitive-exit | ||
| 345 | (system* #$(file-append package "/bin/gitolite") | ||
| 346 | "setup" | ||
| 347 | "-m" "gitolite setup by GNU Guix" | ||
| 348 | "-pk" pubkey-file))) | ||
| 349 | (lambda () | ||
| 350 | (primitive-exit 1)))) | ||
| 351 | (pid (waitpid pid))) | ||
| 352 | |||
| 353 | (when (file-exists? pubkey-file) | ||
| 354 | (delete-file pubkey-file))))))) | ||
| 355 | |||
| 356 | (define gitolite-service-type | ||
| 357 | (service-type | ||
| 358 | (name 'gitolite) | ||
| 359 | (extensions | ||
| 360 | (list (service-extension activation-service-type | ||
| 361 | gitolite-activation) | ||
| 362 | (service-extension account-service-type | ||
| 363 | gitolite-accounts) | ||
| 364 | (service-extension profile-service-type | ||
| 365 | ;; The Gitolite package in Guix uses | ||
| 366 | ;; gitolite-shell in the authorized_keys file, so | ||
| 367 | ;; gitolite-shell needs to be on the PATH for | ||
| 368 | ;; gitolite to work. | ||
| 369 | (lambda (config) | ||
| 370 | (list | ||
| 371 | (gitolite-configuration-package config)))))) | ||
| 372 | (description | ||
| 373 | "Setup @command{gitolite}, a Git hosting tool providing access over SSH.. | ||
| 374 | By default, the @code{git} user is used, but this is configurable. | ||
| 375 | Additionally, Gitolite can integrate with with tools like gitweb or cgit to | ||
| 376 | provide a web interface to view selected repositories."))) | ||
diff --git a/gnu/tests/version-control.scm b/gnu/tests/version-control.scm index 4409b8a12b3..3b935a1b485 100644 --- a/gnu/tests/version-control.scm +++ b/gnu/tests/version-control.scm | |||
| @@ -2,7 +2,6 @@ | |||
| 2 | ;;; Copyright © 2017, 2018 Oleg Pykhalov <go.wigust@gmail.com> | 2 | ;;; Copyright © 2017, 2018 Oleg Pykhalov <go.wigust@gmail.com> |
| 3 | ;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> | 3 | ;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org> |
| 4 | ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org> | 4 | ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org> |
| 5 | ;;; Copyright © 2018 Christopher Baines <mail@cbaines.net> | ||
| 6 | ;;; | 5 | ;;; |
| 7 | ;;; This file is part of GNU Guix. | 6 | ;;; This file is part of GNU Guix. |
| 8 | ;;; | 7 | ;;; |
| @@ -28,17 +27,14 @@ | |||
| 28 | #:use-module (gnu services) | 27 | #:use-module (gnu services) |
| 29 | #:use-module (gnu services version-control) | 28 | #:use-module (gnu services version-control) |
| 30 | #:use-module (gnu services cgit) | 29 | #:use-module (gnu services cgit) |
| 31 | #:use-module (gnu services ssh) | ||
| 32 | #:use-module (gnu services web) | 30 | #:use-module (gnu services web) |
| 33 | #:use-module (gnu services networking) | 31 | #:use-module (gnu services networking) |
| 34 | #:use-module (gnu packages version-control) | 32 | #:use-module (gnu packages version-control) |
| 35 | #:use-module (gnu packages ssh) | ||
| 36 | #:use-module (guix gexp) | 33 | #:use-module (guix gexp) |
| 37 | #:use-module (guix store) | 34 | #:use-module (guix store) |
| 38 | #:use-module (guix modules) | 35 | #:use-module (guix modules) |
| 39 | #:export (%test-cgit | 36 | #:export (%test-cgit |
| 40 | %test-git-http | 37 | %test-git-http)) |
| 41 | %test-gitolite)) | ||
| 42 | 38 | ||
| 43 | (define README-contents | 39 | (define README-contents |
| 44 | "Hello! This is what goes inside the 'README' file.") | 40 | "Hello! This is what goes inside the 'README' file.") |
| @@ -304,111 +300,3 @@ HTTP-PORT." | |||
| 304 | (name "git-http") | 300 | (name "git-http") |
| 305 | (description "Connect to a running Git HTTP server.") | 301 | (description "Connect to a running Git HTTP server.") |
| 306 | (value (run-git-http-test)))) | 302 | (value (run-git-http-test)))) |
| 307 | |||
| 308 | |||
| 309 | ;;; | ||
| 310 | ;;; Gitolite. | ||
| 311 | ;;; | ||
| 312 | |||
| 313 | (define %gitolite-test-admin-keypair | ||
| 314 | (computed-file | ||
| 315 | "gitolite-test-admin-keypair" | ||
| 316 | (with-imported-modules (source-module-closure | ||
| 317 | '((guix build utils))) | ||
| 318 | #~(begin | ||
| 319 | (use-modules (ice-9 match) (srfi srfi-26) | ||
| 320 | (guix build utils)) | ||
| 321 | |||
| 322 | (mkdir #$output) | ||
| 323 | (invoke #$(file-append openssh "/bin/ssh-keygen") | ||
| 324 | "-f" (string-append #$output "/test-admin") | ||
| 325 | "-t" "rsa" | ||
| 326 | "-q" | ||
| 327 | "-N" ""))))) | ||
| 328 | |||
| 329 | (define %gitolite-os | ||
| 330 | (simple-operating-system | ||
| 331 | (dhcp-client-service) | ||
| 332 | (service openssh-service-type) | ||
| 333 | (service gitolite-service-type | ||
| 334 | (gitolite-configuration | ||
| 335 | (admin-pubkey | ||
| 336 | (file-append %gitolite-test-admin-keypair "/test-admin.pub")))))) | ||
| 337 | |||
| 338 | (define (run-gitolite-test) | ||
| 339 | (define os | ||
| 340 | (marionette-operating-system | ||
| 341 | %gitolite-os | ||
| 342 | #:imported-modules '((gnu services herd) | ||
| 343 | (guix combinators)))) | ||
| 344 | |||
| 345 | (define vm | ||
| 346 | (virtual-machine | ||
| 347 | (operating-system os) | ||
| 348 | (port-forwardings `((2222 . 22))))) | ||
| 349 | |||
| 350 | (define test | ||
| 351 | (with-imported-modules '((gnu build marionette) | ||
| 352 | (guix build utils)) | ||
| 353 | #~(begin | ||
| 354 | (use-modules (srfi srfi-64) | ||
| 355 | (rnrs io ports) | ||
| 356 | (gnu build marionette) | ||
| 357 | (guix build utils)) | ||
| 358 | |||
| 359 | (define marionette | ||
| 360 | (make-marionette (list #$vm))) | ||
| 361 | |||
| 362 | (mkdir #$output) | ||
| 363 | (chdir #$output) | ||
| 364 | |||
| 365 | (test-begin "gitolite") | ||
| 366 | |||
| 367 | ;; Wait for sshd to be up and running. | ||
| 368 | (test-assert "service running" | ||
| 369 | (marionette-eval | ||
| 370 | '(begin | ||
| 371 | (use-modules (gnu services herd)) | ||
| 372 | (start-service 'ssh-daemon)) | ||
| 373 | marionette)) | ||
| 374 | |||
| 375 | (display #$%gitolite-test-admin-keypair) | ||
| 376 | |||
| 377 | (setenv "GIT_SSH_VARIANT" "ssh") | ||
| 378 | (setenv "GIT_SSH_COMMAND" | ||
| 379 | (string-join | ||
| 380 | '(#$(file-append openssh "/bin/ssh") | ||
| 381 | "-i" #$(file-append %gitolite-test-admin-keypair | ||
| 382 | "/test-admin") | ||
| 383 | "-o" "UserKnownHostsFile=/dev/null" | ||
| 384 | "-o" "StrictHostKeyChecking=no"))) | ||
| 385 | |||
| 386 | (test-assert "cloning the admin repository" | ||
| 387 | (invoke #$(file-append git "/bin/git") | ||
| 388 | "clone" "-v" | ||
| 389 | "ssh://git@localhost:2222/gitolite-admin" | ||
| 390 | "/tmp/clone")) | ||
| 391 | |||
| 392 | (test-assert "admin key exists" | ||
| 393 | (file-exists? "/tmp/clone/keydir/test-admin.pub")) | ||
| 394 | |||
| 395 | (with-directory-excursion "/tmp/clone" | ||
| 396 | (invoke #$(file-append git "/bin/git") | ||
| 397 | "-c" "user.name=Guix" "-c" "user.email=guix" | ||
| 398 | "commit" | ||
| 399 | "-m" "Test commit" | ||
| 400 | "--allow-empty") | ||
| 401 | |||
| 402 | (test-assert "pushing, and the associated hooks" | ||
| 403 | (invoke #$(file-append git "/bin/git") "push"))) | ||
| 404 | |||
| 405 | (test-end) | ||
| 406 | (exit (= (test-runner-fail-count (test-runner-current)) 0))))) | ||
| 407 | |||
| 408 | (gexp->derivation "gitolite" test)) | ||
| 409 | |||
| 410 | (define %test-gitolite | ||
| 411 | (system-test | ||
| 412 | (name "gitolite") | ||
| 413 | (description "Clone the Gitolite admin repository.") | ||
| 414 | (value (run-gitolite-test)))) | ||
