├── .gitignore ├── .guix-package-path └── gds │ ├── build │ ├── packages │ ├── utils.scm │ └── build-system ├── bin ├── govuk-cli ├── run-system-test ├── govuk-update-development-data ├── govuk-update-repos ├── govuk-config ├── govuk-check-for-govuk-guix-updates ├── govuk-cuirass-jobs ├── govuk-download-backups ├── govuk ├── govuk-refresh └── govuk-aws ├── Makefile ├── gds ├── systems │ ├── govuk │ │ ├── skeletons │ │ │ ├── bashrc │ │ │ └── psqlrc │ │ ├── publishing-e2e-tests-isolated.scm │ │ ├── production.scm │ │ ├── development.scm │ │ ├── utils.scm │ │ ├── publishing-e2e-tests.scm │ │ ├── aws.scm │ │ └── test.scm │ └── utils.scm ├── build-jobs │ ├── govuk │ │ └── cuirass-specifications.scm │ ├── cuirass-entry-point.scm │ └── govuk.scm ├── build │ └── utils.scm ├── scripts │ ├── utils.scm │ └── govuk │ │ ├── data │ │ ├── build-data-directory-with-index.scm │ │ ├── list.scm │ │ └── load.scm │ │ └── system │ │ ├── passphrase.scm │ │ ├── init.scm │ │ ├── start.scm │ │ ├── available-services.scm │ │ └── build.scm ├── data │ ├── govuk.scm │ ├── transformations │ │ ├── build │ │ │ ├── mysql.scm │ │ │ ├── mongodb.scm │ │ │ └── postgresql.scm │ │ └── mysql.scm │ ├── data-source.scm │ ├── tar-archive.scm │ ├── transformations.scm │ ├── tar-extract.scm │ └── s3.scm ├── services │ ├── govuk │ │ ├── admin-environment-style.scm │ │ ├── content-access-limits.scm │ │ ├── tailon.scm │ │ ├── data-snapshot.scm │ │ ├── router.scm │ │ └── tls.scm │ ├── delayed-job.scm │ ├── utils │ │ └── databases │ │ │ ├── elasticsearch.scm │ │ │ ├── rabbitmq.scm │ │ │ └── mongodb.scm │ ├── base.scm │ └── sidekiq.scm ├── packages │ ├── third-party │ │ ├── ruby.scm │ │ └── phantomjs.scm │ ├── guix.scm │ ├── utils │ │ └── bundler-build.scm │ ├── utils.scm │ └── govuk │ │ └── ruby.scm ├── build-system │ └── rails.scm ├── utils.scm └── services.scm ├── scripts └── build-all-packages ├── jenkins └── package-updates.groovy ├── LICENSE ├── pre-inst-env ├── doc ├── installation.md ├── local-data.md └── local-development.md ├── guix-pre-inst-env ├── README.org └── .dir-locals.el /.gitignore: -------------------------------------------------------------------------------- 1 | test-results 2 | -------------------------------------------------------------------------------- /.guix-package-path/gds/build: -------------------------------------------------------------------------------- 1 | ../../gds/build/ -------------------------------------------------------------------------------- /.guix-package-path/gds/packages: -------------------------------------------------------------------------------- 1 | ../../gds/packages/ -------------------------------------------------------------------------------- /.guix-package-path/gds/utils.scm: -------------------------------------------------------------------------------- 1 | ../../gds/utils.scm -------------------------------------------------------------------------------- /.guix-package-path/gds/build-system: -------------------------------------------------------------------------------- 1 | ../../gds/build-system/ -------------------------------------------------------------------------------- /bin/govuk-cli: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | GOVUKCLI="$(readlink -f $GOVUK_GUIX_ROOT/../govuk-aws/tools/govukcli)" 4 | 5 | bash $GOVUKCLI $@ 6 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | 2 | check-system: 3 | bash ./bin/run-system-test gds/systems/govuk/publishing-e2e-tests-isolated.scm 4 | 5 | debug-publishing-e2e-tests: 6 | bash ./guix-pre-inst-env guix system container -N --no-grafts --fallback gds/systems/govuk/publishing-e2e-tests.scm --share=../publishing-e2e-tests=/var/apps/publishing-e2e-tests 7 | -------------------------------------------------------------------------------- /gds/systems/govuk/skeletons/bashrc: -------------------------------------------------------------------------------- 1 | export SHELL 2 | export HOME="/root" 3 | 4 | source /root/.environment 5 | source /root/.bash_aliases 6 | 7 | green="\[\\e[0;32m\\]" 8 | yellow="\[\\e[0;33m\\]" 9 | blue="\[\\e[0;34m\\]" 10 | reset_color="\\[\\e[39m\\]" 11 | 12 | PS1="\\n${blue}\\h: ${reset_color} ${yellow}\\w ${green}\\n${reset_color}→ " 13 | -------------------------------------------------------------------------------- /gds/build-jobs/govuk/cuirass-specifications.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds build-jobs govuk cuirass-specifications) 2 | #:export (govuk-packages)) 3 | 4 | (define govuk-packages 5 | `((#:name . "govuk-packages") 6 | (#:url . "govuk-guix") 7 | (#:load-path . ".") 8 | (#:file . "gds/build-jobs/cuirass-entry-point.scm") 9 | (#:proc . govuk-packages-jobs) 10 | (#:arguments . ()) 11 | (#:branch . "master") 12 | (#:no-compile? . 1))) 13 | 14 | (list govuk-packages) 15 | -------------------------------------------------------------------------------- /scripts/build-all-packages: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -ex 4 | 5 | EXTRA_PACKAGE_NAMES="mongodb mongo-tools postgresql rabbitmq redis ungoogled-chromium" 6 | 7 | PACKAGE_NAMES="$(./guix-pre-inst-env guile -c "(begin (use-modules (gnu packages) (guix packages) (guix discovery)) (display (string-join (map package-name (fold-packages cons '() (all-modules '((\".\" . \"gds/packages\"))))))))")" 8 | 9 | ./guix-pre-inst-env guix build --no-grafts --fallback --keep-going $PACKAGE_NAMES $EXTRA_PACKAGE_NAMES 10 | -------------------------------------------------------------------------------- /gds/build/utils.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds build utils) 2 | #:export (run-command)) 3 | 4 | (define (run-command . args) 5 | (simple-format #t "Running command: ~A\n" (string-join args)) 6 | (let 7 | ((exit-val 8 | (status:exit-val (apply system* args)))) 9 | (display "\n") 10 | (if (zero? exit-val) 11 | #t 12 | (begin 13 | (simple-format 14 | #t 15 | "Command failed with exit status ~A: ~A\n" 16 | exit-val 17 | (string-join args)) 18 | #f)))) 19 | -------------------------------------------------------------------------------- /gds/scripts/utils.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds scripts utils) 2 | #:use-module (ice-9 match) 3 | #:use-module (srfi srfi-1) 4 | #:export (option-values 5 | option-value)) 6 | 7 | (define (option-values opts key) 8 | (reverse 9 | (filter-map (match-lambda 10 | ((head . tail) 11 | (and (eq? key head) tail)) 12 | (_ #f)) 13 | opts))) 14 | 15 | (define* (option-value opts key #:key default) 16 | (let ((values (option-values opts key))) 17 | (if (null? values) 18 | default 19 | (car values)))) 20 | -------------------------------------------------------------------------------- /gds/data/govuk.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds data govuk) 2 | #:use-module (srfi srfi-1) 3 | #:use-module (gds data data-source) 4 | #:use-module (gds data govuk sources data-directory-with-index) 5 | #:use-module (gds data govuk sources govuk-puppet) 6 | #:use-module (gds data govuk sources govuk-puppet-aws) 7 | #:export (data-sources 8 | all-extracts)) 9 | 10 | (define data-sources 11 | (list data-directory-with-index-data-source 12 | govuk-puppet-aws-data-source 13 | govuk-puppet-data-source)) 14 | 15 | (define (all-extracts) 16 | (append-map 17 | (lambda (list-extracts-thunk) (list-extracts-thunk)) 18 | (map data-source-list-extracts data-sources))) 19 | -------------------------------------------------------------------------------- /bin/run-system-test: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -o pipefail 4 | 5 | RESULTS_DIRECTORY="$(dirname $(dirname ${BASH_SOURCE[0]}))/test-results" 6 | 7 | mkdir -p "$RESULTS_DIRECTORY" 8 | rm -f "$RESULTS_DIRECTORY/all-tests-succeeded" 9 | 10 | START_SCRIPT="$(bash ./guix-pre-inst-env guix system container --no-grafts --fallback $@ --share=$RESULTS_DIRECTORY=/var/apps/publishing-e2e-tests/tmp/results | tee /dev/stderr | tail -n1)" 11 | 12 | if [ $? -eq 0 ]; then 13 | sudo "$START_SCRIPT" 14 | fi 15 | 16 | echo 17 | echo "Test results saved to $RESULTS_DIRECTORY:" 18 | echo 19 | echo " file://$(readlink -f "$RESULTS_DIRECTORY")/test-results.html" 20 | echo 21 | 22 | if [ -a "$RESULTS_DIRECTORY/all-tests-succeeded" ]; then 23 | exit 0 24 | else 25 | exit 1 26 | fi 27 | -------------------------------------------------------------------------------- /bin/govuk-update-development-data: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | if [ ! -n "$BASH" ] ; then 4 | exec bash "$0" $@ 5 | fi 6 | 7 | set -e 8 | set -o pipefail 9 | 10 | if [ "$1" != "--no-download" ]; then 11 | govuk download-backups 12 | EXTRA_ARGS=${@:1} 13 | else 14 | EXTRA_ARGS=${@:2} 15 | fi 16 | 17 | TWO_WEEKS_AGO="$(date --date="2 weeks ago" '+%d/%m/%Y')" 18 | 19 | DATA_DIRECTORY_WITH_INDEX="$(govuk data build-data-directory-with-index --after=$TWO_WEEKS_AGO $EXTRA_ARGS | tail -n1)" 20 | 21 | GCROOT_DIRECTORY="/var/guix/gcroots/govuk-development-data" 22 | if [ -d "$GCROOT_DIRECTORY" ]; then 23 | rm -f "$GCROOT_DIRECTORY/current" 24 | ln -s "$DATA_DIRECTORY_WITH_INDEX" "$GCROOT_DIRECTORY/current" 25 | fi 26 | 27 | govuk aws --profile govuk-test -- aws s3 sync --delete "$DATA_DIRECTORY_WITH_INDEX" s3://govuk-development-data-test/ 28 | -------------------------------------------------------------------------------- /gds/services/govuk/admin-environment-style.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds services govuk admin-environment-style) 2 | #:use-module (gnu services) 3 | #:use-module (gds services) 4 | #:export (use-govuk-admin-template-environment-label)) 5 | 6 | (define (use-govuk-admin-template-environment-label services label) 7 | (map 8 | (lambda (s) 9 | (service 10 | (service-kind s) 11 | (if 12 | (list? (service-parameters s)) 13 | (map 14 | (lambda (parameter) 15 | (if 16 | (service-startup-config? parameter) 17 | (service-startup-config-with-additional-environment-variables 18 | parameter 19 | `(("GOVUK_ADMIN_TEMPLATE_ENVIRONMENT_LABEL" . ,label))) 20 | parameter)) 21 | (service-parameters s)) 22 | (service-parameters s)))) 23 | services)) 24 | -------------------------------------------------------------------------------- /gds/data/transformations/build/mysql.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds data transformations build mysql) 2 | #:use-module (srfi srfi-1) 3 | #:export (decompress-file-and-pipe-to-mysql)) 4 | 5 | (define* (decompress-file-and-pipe-to-mysql file database) 6 | (define decompressor 7 | (assoc-ref '(("gz" . "gzip") 8 | ("xz" . "xz")) 9 | (last (string-split file #\.)))) 10 | 11 | (let ((command 12 | (string-join 13 | `("set -eo pipefail;" 14 | "pv" "--force" ,file "|" 15 | ,@(if decompressor 16 | `(,decompressor "-d" "|") 17 | '()) 18 | "mysql" ,(string-append "--database=" database)) 19 | " "))) 20 | (simple-format #t "ungzip-file-and-pipe-to-mysql running:\n ~A\n" 21 | command) 22 | (force-output) 23 | (or (zero? (system command)) 24 | (error "ungzip-file-and-pipe-to-mysql failed")))) 25 | -------------------------------------------------------------------------------- /gds/build-jobs/cuirass-entry-point.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds build-jobs cuirass-entry-point) 2 | #:use-module (ice-9 match) 3 | #:use-module (ice-9 popen) 4 | #:use-module (ice-9 rdelim) 5 | #:export (govuk-package-jobs)) 6 | 7 | (define working-directory 8 | (getcwd)) 9 | 10 | (define (govuk-packages-jobs . args) 11 | (let* ((port (open-pipe* OPEN_READ 12 | (string-append working-directory "/bin/govuk") 13 | "cuirass-jobs")) 14 | (jobs (match (read port) 15 | ;; If an error occurred during evaluation report it, 16 | ;; otherwise, suppose that data read from port are 17 | ;; correct and keep things going. 18 | ((? eof-object?) 19 | (raise "error: govuk-cuirass-jobs: eof")) 20 | (data data)))) 21 | (close-pipe port) 22 | (map (lambda (job) 23 | (lambda () job)) 24 | jobs))) 25 | -------------------------------------------------------------------------------- /gds/data/data-source.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds data data-source) 2 | #:use-module (guix records) 3 | #:export ( 4 | data-source 5 | data-source? 6 | data-source-name 7 | data-source-list-extracts 8 | data-source-list-extracts-from-data-directory-index 9 | data-source-data-directory-with-index 10 | data-source-priority)) 11 | 12 | (define-record-type* 13 | data-source make-data-source 14 | data-source? 15 | (name data-source-name) 16 | (list-extracts data-source-list-extracts) 17 | (list-extracts-from-data-directory-index 18 | data-source-list-extracts-from-data-directory-index 19 | (default #f)) 20 | (data-directory-with-index data-source-data-directory-with-index 21 | (default #f)) 22 | (priority data-source-priority 23 | (default #f))) 24 | -------------------------------------------------------------------------------- /gds/data/transformations/build/mongodb.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds data transformations build mongodb) 2 | #:use-module (srfi srfi-1) 3 | #:export (decompress-file-and-pipe-to-mongorestore)) 4 | 5 | (define* (decompress-file-and-pipe-to-mongorestore file database) 6 | (define decompressor 7 | (assoc-ref '(("gz" . "gzip") 8 | ("xz" . "xz")) 9 | (last (string-split file #\.)))) 10 | 11 | (let ((command 12 | (string-join 13 | `("set -eo pipefail;" 14 | "pv" "--force" ,file "|" 15 | ,@(if decompressor 16 | `(,decompressor "-d" "|") 17 | '()) 18 | "mongorestore" "--quiet" "-d" ,database "--archive") 19 | " "))) 20 | (simple-format #t "ungzip-file-and-pipe-to-mongorestore running:\n ~A\n" 21 | command) 22 | (force-output) 23 | (or (zero? (system command)) 24 | (error "ungzip-file-and-pipe-to-mongorestore failed")))) 25 | -------------------------------------------------------------------------------- /jenkins/package-updates.groovy: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env groovy 2 | 3 | properties([ 4 | pipelineTriggers([ 5 | upstream(upstreamProjects: 'integration-app-deploy'), 6 | cron('H/30 7-19 * * 1-5') 7 | ]) 8 | ]) 9 | 10 | node("ci-agent-2") { 11 | try { 12 | stage("Checkout") { 13 | checkout([$class: 'GitSCM', 14 | branches: scm.branches, 15 | userRemoteConfigs: [[ 16 | credentialsId: 'govuk-ci-ssh-key', 17 | url: "git@github.com:alphagov/govuk-guix.git" 18 | ]] 19 | ]) 20 | } 21 | 22 | stage("govuk refresh") { 23 | withCredentials([ 24 | string( 25 | credentialsId: 'github-token-govuk-ci', 26 | variable: 'GUIX_GITHUB_TOKEN' 27 | ) 28 | ]) { 29 | sh "bash ./bin/govuk refresh --commit" 30 | } 31 | } 32 | 33 | stage("git push") { 34 | sshagent(['govuk-ci-ssh-key']) { 35 | sh("git push origin HEAD:master") 36 | } 37 | } 38 | } catch (e) { 39 | currentBuild.result = "FAILED" 40 | throw e 41 | } 42 | } 43 | -------------------------------------------------------------------------------- /gds/systems/govuk/publishing-e2e-tests-isolated.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds systems govuk publishing-e2e-tests-isolated) 2 | #:use-module (gnu system) 3 | #:use-module (gnu services) 4 | #:use-module (gnu services base) 5 | #:use-module (gnu services networking) 6 | #:use-module (gds systems govuk publishing-e2e-tests) 7 | #:export (publishing-e2e-tests-isolated-os)) 8 | 9 | (define publishing-e2e-tests-isolated-os 10 | (operating-system 11 | (inherit publishing-e2e-tests-os) 12 | (services 13 | (cons 14 | (service static-networking-service-type 15 | (list (static-networking (interface "lo") 16 | (ip "127.0.0.1") 17 | (provision '(loopback networking))))) 18 | (filter 19 | (lambda (s) 20 | (not (eq? 21 | 'dummy-loopback-service 22 | (service-type-name 23 | (service-kind s))))) 24 | (operating-system-user-services 25 | publishing-e2e-tests-os)))))) 26 | 27 | publishing-e2e-tests-isolated-os 28 | -------------------------------------------------------------------------------- /bin/govuk-update-repos: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | bold="$(tput bold)" 6 | reset="$(tput sgr0)" 7 | 8 | GOVUK_ROOT="$(dirname "$GOVUK_GUIX_ROOT")" 9 | 10 | for repo in "$@" 11 | do 12 | cd "$GOVUK_ROOT/$repo" || true 13 | 14 | if [ ! -d ".git" ]; then 15 | echo "$repo: skipped as not a Git repository" 16 | else 17 | BRANCH="$(git symbolic-ref --short HEAD)" 18 | 19 | if [ "$BRANCH" != "master" ]; then 20 | echo "$repo: ${bold}skipped: on non-master branch${reset}" 21 | elif ! git diff --quiet --ignore-submodules --no-ext-diff; then 22 | echo "$repo: ${bold}skipped: uncommitted local changes${reset}" 23 | else 24 | if ! git fetch origin; then 25 | echo "$repo: ${bold}error fetching from origin${reset}" 26 | fi 27 | if ! git merge --ff-only origin/master >/dev/null 2>&1; then 28 | echo "$repo: ${bold}skipped: unpushed local commits${reset}" 29 | else 30 | echo "$repo: now up to date" 31 | fi 32 | fi 33 | fi 34 | done 35 | -------------------------------------------------------------------------------- /gds/scripts/govuk/data/build-data-directory-with-index.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds scripts govuk data build-data-directory-with-index) 2 | #:use-module (srfi srfi-19) 3 | #:use-module (guix store) 4 | #:use-module (guix derivations) 5 | #:use-module (guix gexp) 6 | #:use-module (gds data govuk sources govuk-puppet-aws) 7 | #:use-module (gds data govuk sources data-directory-with-index) 8 | #:export (build-data-directory-with-index)) 9 | 10 | (define* (build-data-directory-with-index services data-extracts 11 | #:key dry-run? verbose? max-jobs) 12 | (with-store store 13 | (set-build-options store #:max-build-jobs max-jobs) 14 | 15 | (let ((derivation 16 | ((lower-object (data-directory-with-index services data-extracts)) 17 | store))) 18 | (if dry-run? 19 | (simple-format #t "Would build derivation ~A" derivation) 20 | (begin 21 | (simple-format #t "Building derivations ~A" derivation) 22 | (build-derivations store (list derivation)))) 23 | (simple-format #t "\n~A\n" (derivation->output-path derivation))))) 24 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2019 Crown Copyright (Government Digital Service) 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /bin/govuk-config: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ruby 2 | 3 | require 'yaml' 4 | 5 | USAGE = <<~FOO 6 | usage: 7 | 8 | govuk config key [value] 9 | FOO 10 | 11 | def config_file 12 | @config_file ||= begin 13 | directory = ENV.fetch('XDG_CONFIG_HOME', "#{Dir.home}/.config") 14 | 15 | File.join(directory, 'config.yaml') 16 | end 17 | end 18 | 19 | def set(key, value) 20 | if File.exist? config_file 21 | config = YAML::load_file(config_file) 22 | else 23 | config = {} 24 | end 25 | 26 | config[key] = value 27 | 28 | File.write(config_file, config.to_yaml) 29 | end 30 | 31 | def get(key) 32 | YAML::load_file(config_file)[key] 33 | end 34 | 35 | def print_current_configuration 36 | YAML::load_file(config_file).each do |key, value| 37 | STDERR.puts " - #{key}: #{value}" 38 | end 39 | end 40 | 41 | def main 42 | key, value, *_rest = ARGV 43 | 44 | unless key 45 | STDERR.puts USAGE 46 | 47 | STDERR.puts "\nCurrent configuration:" 48 | print_current_configuration 49 | 50 | exit 1 51 | end 52 | 53 | if value 54 | set key, value 55 | 56 | STDERR.puts "#{key} set to #{value}" 57 | else 58 | puts get(key) 59 | end 60 | 61 | exit 0 62 | end 63 | 64 | main 65 | -------------------------------------------------------------------------------- /gds/services/govuk/content-access-limits.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds services govuk content-access-limits) 2 | #:use-module (gds services) 3 | #:use-module (gds services utils) 4 | #:use-module (gds services govuk) 5 | #:export (set-jwt-auth-secret)) 6 | 7 | (define* (set-jwt-auth-secret services 8 | #:optional #:key 9 | (secret (random-base16-string 30))) 10 | (define (add-environment-variable ssc) 11 | (service-startup-config-with-additional-environment-variables 12 | ssc 13 | `(("JWT_AUTH_SECRET" . ,secret)))) 14 | 15 | (update-services-parameters 16 | services 17 | (list 18 | (cons 19 | authenticating-proxy-service-type 20 | (list 21 | (cons service-startup-config? add-environment-variable))) 22 | (cons 23 | asset-manager-service-type 24 | (list 25 | (cons service-startup-config? add-environment-variable))) 26 | (cons 27 | publisher-service-type 28 | (list 29 | (cons service-startup-config? add-environment-variable))) 30 | (cons 31 | content-publisher-service-type 32 | (list 33 | (cons service-startup-config? add-environment-variable))) 34 | (cons 35 | whitehall-service-type 36 | (list 37 | (cons service-startup-config? add-environment-variable)))))) 38 | -------------------------------------------------------------------------------- /bin/govuk-check-for-govuk-guix-updates: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | if [ ! -n "$BASH" ] ; then 4 | exec bash "$0" $@ 5 | fi 6 | 7 | set -e 8 | 9 | case "$0" in 10 | \/*) SCRIPT_PATH="$0";; 11 | *) SCRIPT_PATH=$(readlink -f "$0");; 12 | esac 13 | 14 | GOVUK_GUIX_REPO="$(dirname "$(dirname "$SCRIPT_PATH")")" 15 | 16 | cd "$GOVUK_GUIX_REPO" 17 | 18 | CURTIME=$(date +%s) 19 | if [ -f .git/FETCH_HEAD ]; then 20 | case "$(uname -s)" in 21 | "Darwin") 22 | # stat isn't GNU stat, so different options apply 23 | FILETIME=$(stat -f %m .git/FETCH_HEAD);; 24 | *) 25 | FILETIME=$(stat .git/FETCH_HEAD -c %Y);; 26 | esac 27 | else 28 | FILETIME=0 29 | fi 30 | TIMEDIFF=$(expr $CURTIME - $FILETIME) 31 | 32 | CHECKPERIOD=86400 # 1 day 33 | 34 | if [ $TIMEDIFF -lt $CHECKPERIOD ]; then 35 | exit 0 36 | fi 37 | 38 | git fetch --quiet 39 | 40 | REMOTE_REF="$(git for-each-ref --format='%(upstream:short)' refs/heads/master)" 41 | COUNT="$(git rev-list --count master..$REMOTE_REF)" 42 | 43 | if [[ $COUNT -lt 2 ]]; then 44 | exit 0 45 | fi 46 | 47 | YELLOW="\e[0;33m" 48 | BOLDYELLOW="\e[1;33m" 49 | RESET="\e[0m" 50 | 51 | echo -e "\n${YELLOW}There are $COUNT new commits available for govuk-guix, consider running:" 52 | echo 53 | echo -e " ${BOLDYELLOW}govuk update-repos govuk-guix${RESET}" 54 | echo 55 | 56 | sleep 1 57 | -------------------------------------------------------------------------------- /bin/govuk-cuirass-jobs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/guile --no-auto-compile 2 | -*- scheme -*- 3 | !# 4 | 5 | ;; To allow this script to be run directly, even from the Git 6 | ;; repository, check if the environment is setup by checking if the 7 | ;; (gds services) module is loadable. If it's not loadable, start this 8 | ;; script again, but use the guix-pre-inst-env helper to setup the 9 | ;; environment. 10 | (catch 11 | #t 12 | (lambda () 13 | (resolve-interface '(gds services))) 14 | (lambda args 15 | (let* ((govuk-guix-root 16 | (or (and=> (current-filename) 17 | (lambda (x) 18 | (dirname (dirname x)))) 19 | (getenv "GOVUK_GUIX_ROOT") 20 | (error "Unable to locate the govuk-guix root"))) 21 | (command-full-path 22 | (string-append govuk-guix-root "/bin/govuk-cuirass-jobs"))) 23 | (apply execlp 24 | "bash" 25 | "--" 26 | (string-append govuk-guix-root "/guix-pre-inst-env") 27 | "guile" 28 | command-full-path 29 | (cdr (command-line)))))) 30 | 31 | (use-modules (ice-9 pretty-print) 32 | (guix store) 33 | (gds build-jobs govuk)) 34 | 35 | (define (output-jobs jobs) 36 | (pretty-print 37 | jobs 38 | (current-output-port))) 39 | 40 | (with-store store 41 | (output-jobs 42 | (govuk-packages-jobs store))) 43 | -------------------------------------------------------------------------------- /gds/systems/govuk/skeletons/psqlrc: -------------------------------------------------------------------------------- 1 | \set VERBOSITY verbose 2 | 3 | -- [user]@[host]:[port]/[db]['*' if we are in a transaction]['#' if we are root-like; '>' otherwise] 4 | \set PROMPT1 '%n@%m:%>/%/%x%# ' 5 | 6 | -- Make history ignore all lines entered that were preceded by spaces, and 7 | -- ignore any entries that matched the previous line entered. 8 | \set HISTCONTROL ignoreboth 9 | 10 | -- Keep a different history file for each database name you log on to. 11 | \set HISTFILE ~/.psql_history- :DBNAME 12 | 13 | -- Keep a history of the last 2000 commands. 14 | \set HISTSIZE 2000 15 | 16 | -- Instead of displaying nulls as blank space, which look the same as empty 17 | -- strings (but are not the same!), show nulls as [NULL]. 18 | \pset null '[NULL]' 19 | 20 | -- Show pretty unicode lines between rows and columns in select results. 21 | \pset linestyle unicode 22 | 23 | -- Show pretty lines around the outside of select results. 24 | \pset border 2 25 | 26 | -- Show how long it takes to run each query. 27 | \timing 28 | 29 | -- Show the application_name in pg_stat_activity. 30 | -- Good database citizens set this field so we know who to blame when a query 31 | -- hogs resources, or somebody stays idle in transaction for too long. 32 | set application_name to christopherbaines_psql; commit; 33 | 34 | -- Set bytea output to show as many ASCII letters as possible. 35 | -- (Handy if you are storing text whose encoding you do not know in bytea columns.) 36 | set bytea_output to escape; commit; 37 | 38 | \set ECHO all 39 | -------------------------------------------------------------------------------- /gds/services/govuk/tailon.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds services govuk tailon) 2 | #:use-module (gnu services) 3 | #:use-module (gnu services admin) 4 | #:use-module (gnu services web) 5 | #:use-module (gds services govuk nginx) 6 | #:use-module (gds services govuk signon)) 7 | 8 | (define-public govuk-tailon-service-type 9 | (service-type 10 | (inherit tailon-service-type) 11 | (extensions 12 | (cons* 13 | (service-extension govuk-nginx-service-type 14 | (const 15 | (list 16 | (nginx-server-configuration 17 | (locations 18 | (list 19 | (nginx-location-configuration 20 | (uri "/ws") 21 | (body '(" 22 | proxy_pass http://localhost:54001/ws; 23 | proxy_http_version 1.1; 24 | proxy_set_header Upgrade $http_upgrade; 25 | proxy_set_header Connection \"upgrade\"; 26 | "))) 27 | (nginx-location-configuration 28 | (uri "/") 29 | (body '("proxy_pass http://localhost:54001;"))))) 30 | (server-name (list 31 | "tailon.dev.gov.uk" 32 | "logs.dev.gov.uk")))))) 33 | (service-type-extensions tailon-service-type))))) 34 | -------------------------------------------------------------------------------- /gds/scripts/govuk/system/passphrase.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds scripts govuk system passphrase) 2 | #:use-module (ice-9 rdelim) 3 | #:use-module (srfi srfi-26) 4 | #:use-module (guix ui) 5 | #:export (passphrase)) 6 | 7 | (define (passphrase opts) 8 | (or (and=> (getenv "GOVUK_GUIX_DEVELOPMENT_PASSPHRASE") 9 | (lambda (passphrase) 10 | (simple-format 11 | #t 12 | "The passphrase (set through GOVUK_GUIX_DEVELOPMENT_PASSPHRASE) is: ~A" 13 | passphrase))) 14 | (let ((data-dir (or (getenv "XDG_DATA_HOME") 15 | (and=> (getenv "HOME") 16 | (cut string-append <> "/.local/share"))))) 17 | (if (file-exists? data-dir) 18 | (let* ((passphrase-file 19 | (string-append 20 | data-dir 21 | "/govuk-guix/systems/development/passphrase"))) 22 | (if (file-exists? passphrase-file) 23 | (let ((passphrase 24 | (call-with-input-file passphrase-file read-line))) 25 | (simple-format 26 | #t 27 | "The passphrase for the development system is recorded in ~A. It is:\n\n ~A\n\n" 28 | passphrase-file 29 | passphrase)) 30 | (leave 31 | (G_ "The passphrase file could not be found at ~A") 32 | passphrase-file))) 33 | (leave 34 | (G_ "The data directory could not be determined")))))) 35 | -------------------------------------------------------------------------------- /pre-inst-env: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | if [[ $# -eq 0 ]] ; then 4 | cat < 10 | delayed-job-config 11 | delayed-job-config? 12 | delayed-job-config-queues 13 | 14 | delayed-job-worker-shepherd-service)) 15 | 16 | (define-record-type* 17 | delayed-job-config make-delayed-job-config 18 | delayed-job-config? 19 | (queues delayed-job-config-queues 20 | (default #f))) 21 | 22 | (define (delayed-job-worker-shepherd-service 23 | name 24 | delayed-job-config 25 | requirements 26 | directory 27 | user 28 | environment) 29 | (shepherd-service 30 | (provision (list (string->symbol name))) 31 | (documentation 32 | (simple-format #f "~A service" name)) 33 | (requirement requirements) 34 | (respawn? #f) 35 | (start 36 | #~(lambda args 37 | (display #$(simple-format #f "starting ~A service\n" name)) 38 | (apply 39 | #$#~(make-forkexec-constructor 40 | '("rake" "jobs:work") 41 | #:user #$user 42 | #:log-file #$(string-append 43 | "/var/log/" name ".log") 44 | #:directory #$directory 45 | #:environment-variables 46 | '#$(map 47 | (match-lambda 48 | ((key . value) 49 | (string-append key "=" value))) 50 | environment)) 51 | args))) 52 | (stop #~(make-kill-destructor)))) 53 | -------------------------------------------------------------------------------- /gds/scripts/govuk/system/init.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds scripts govuk system init) 2 | #:use-module (srfi srfi-1) 3 | #:use-module (guix derivations) 4 | #:use-module (guix grafts) 5 | #:use-module (guix monads) 6 | #:use-module (guix store) 7 | #:use-module (guix gexp) 8 | #:use-module (guix scripts build) 9 | ;; TODO Ideally this functionality would be available outside of a script 10 | #:use-module ((guix scripts system) #:prefix guix-scripts-system:) 11 | #:use-module (gnu system) 12 | #:use-module (gnu bootloader) 13 | #:use-module (gnu system vm) 14 | #:use-module (gnu system file-systems) 15 | #:use-module (gds systems utils packer) 16 | #:use-module (gds scripts utils) 17 | #:use-module (gds scripts govuk system) 18 | #:export (init)) 19 | 20 | (define (init opts) 21 | (let* ((target (assq-ref opts 'target)) 22 | (os (alter-services-for-vm 23 | (opts->operating-system opts))) 24 | (bootloader-target 25 | (option-value 26 | opts 27 | 'bootloader-target 28 | #:default 29 | (bootloader-configuration-target 30 | (operating-system-bootloader os))))) 31 | 32 | (display-system-information os) 33 | 34 | (with-store store 35 | (set-build-options-from-command-line store opts) 36 | 37 | (run-with-store store 38 | (mbegin %store-monad 39 | (set-grafting #f) 40 | (guix-scripts-system:perform-action 41 | 'init os 42 | #:dry-run? #f 43 | #:derivations-only? #f 44 | #:skip-safety-checks? #f 45 | 46 | #:use-substitutes? #t 47 | #:file-system-type "ext4" 48 | #:image-size 'guess 49 | #:full-boot? #t 50 | #:install-bootloader? #t 51 | #:target (assq-ref opts 'target) 52 | #:bootloader-target bootloader-target)))) 53 | (exit 0))) 54 | -------------------------------------------------------------------------------- /gds/scripts/govuk/system/start.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds scripts govuk system start) 2 | #:use-module (ice-9 format) 3 | #:use-module (srfi srfi-1) 4 | #:use-module (gds scripts govuk system) 5 | #:export (start)) 6 | 7 | (define (start opts) 8 | (define (sudo-path) 9 | (find 10 | file-exists? 11 | '("/run/setuid-programs/sudo" 12 | "/usr/bin/sudo"))) 13 | 14 | (define* (run args #:key as-root) 15 | (let ((command 16 | (if as-root 17 | (if (eq? (getuid) 1) 18 | args 19 | (cons (sudo-path) args)) 20 | args))) 21 | (format #t "Running command:~% ~a~2%" (string-join command " ")) 22 | (status:exit-val 23 | (apply system* command)))) 24 | 25 | (let* ((type (assq-ref opts 'type)) 26 | (start-script-builder 27 | (or (assq-ref `((vm-start-script . ,vm-start-script) 28 | (container-start-script . ,container-start-script)) 29 | type) 30 | (begin 31 | (simple-format #t "start is not supported for type:~A\n" 32 | type) 33 | (exit 1)))) 34 | (os (opts->operating-system 35 | opts 36 | #:default-read-bundle-install-input-as-tar-archive? 37 | (assq-ref 38 | '((vm-image-and-system . #t) 39 | (vm-start-script . #t) 40 | (container-start-script . #f)) 41 | type))) 42 | (start-script (start-script-builder os opts))) 43 | 44 | (display-system-information os) 45 | (newline) 46 | (exit 47 | (run `(,start-script 48 | ,@(if (eq? type 'vm-start-script) 49 | '("-m" "8G" 50 | "-net" "user" 51 | "-net" "nic,model=virtio" 52 | "-enable-kvm") 53 | '())) 54 | #:as-root (eq? type 'container-start-script))))) 55 | -------------------------------------------------------------------------------- /doc/installation.md: -------------------------------------------------------------------------------- 1 | # Installation 2 | 3 | *** 4 | __If you encounter any difficulties or problems with govuk-guix, please [open an issue][open-an-issue].__ 5 | *** 6 | [open-an-issue]: https://github.com/alphagov/govuk-guix/issues 7 | 8 | ## Contents 9 | 10 | - [Prerequisites](#prerequisites) 11 | - [Steps](#steps) 12 | 13 | ## Prerequisites 14 | 15 | Using govuk-guix requires a Guix build daemon. Guix can be installed 16 | either [alongside an existing operating system][guix-installation], or 17 | as as an operating system itself (called [GuixSD][guixsd]). 18 | 19 | Additionally, if you are using govuk-puppet, there is a 20 | [guix branch of govuk-puppet][govuk-puppet-guix] which contains a 21 | Puppet module to automate the installation of the binary release of 22 | Guix. 23 | 24 | [guix-installation]: https://www.gnu.org/software/guix/manual/html_node/Installation.html#Installation 25 | [guixsd]: https://www.gnu.org/software/guix/manual/html_node/GNU-Distribution.html 26 | [govuk-puppet-guix]: https://github.com/alphagov/govuk-puppet/tree/guix 27 | 28 | ## Steps 29 | 30 | Once the [prerequisites](#prerequisites) are met, the easiest way to 31 | use govuk-guix is to add the `bin/` directory to the `PATH`. 32 | 33 | Once the `govuk` script can be run, it can be used to run the commands 34 | related to [data][local-data] and [systems][local-development]. 35 | 36 | [local-data]: local-data.md 37 | [local-development]: local-development.md 38 | 39 | ### `govuk` script 40 | 41 | The `govuk` script provides a consistent way to run other programs 42 | related to GOV.UK, while helping to handle differences in environment. 43 | 44 | The 2nd argument to `govuk` is the program to run. For example, `govuk 45 | data` will run the `govuk-data` program. Programs are found through 46 | searching the `PATH`, combined with the `GOVUK_EXEC_PATH`, which will 47 | default to include the directory in which the `govuk` script itself 48 | resides. 49 | 50 | Other programs can be run through the `govuk` script, they must be on 51 | the `PATH` or `GOVUK_EXEC_PATH`, and the file must start with 52 | `govuk-`. 53 | -------------------------------------------------------------------------------- /gds/services/utils/databases/elasticsearch.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds services utils databases elasticsearch) 2 | #:use-module (ice-9 match) 3 | #:use-module (guix gexp) 4 | #:use-module (guix records) 5 | #:use-module (gnu packages databases) 6 | #:use-module (gnu packages compression) 7 | #:export ( 8 | elasticsearch-connection-config 9 | elasticsearch-connection-config? 10 | elasticsearch-connection-config-port 11 | elasticsearch-connection-config-host 12 | 13 | elasticsearch-restore-gexp)) 14 | 15 | (define-record-type* 16 | elasticsearch-connection-config make-elasticsearch-connection-config 17 | elasticsearch-connection-config? 18 | (host elasticsearch-connection-config-host 19 | (default "localhost")) 20 | (port elasticsearch-connection-config-port 21 | (default 5432))) 22 | 23 | (define* (elasticsearch-restore-gexp database-connection index-name file 24 | #:key alias overrides batch-size 25 | dry-run?) 26 | (match database-connection 27 | (($ host port) 28 | #~(lambda () 29 | (let ((command 30 | (list 31 | (string-append #$es-dump-restore "/bin/es_dump_restore") 32 | #$(if alias "restore_alias" "restore") 33 | #$(simple-format #f "http://~A:~A" host (number->string port)) 34 | #$@(if alias (list alias) '()) 35 | #$index-name 36 | #$file 37 | #$@(if overrides (list overrides) '()) 38 | #$@(if batch-size (list (number->string batch-size)) '())))) 39 | #$@(if dry-run? 40 | '((simple-format #t "Would run command: ~A\n" 41 | (string-join command " "))) 42 | '((simple-format #t "Running command: ~A\n" (string-join command " ")) 43 | (zero? 44 | (apply system* command))))))))) 45 | -------------------------------------------------------------------------------- /gds/packages/third-party/ruby.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds packages third-party ruby) 2 | #:use-module ((guix licenses) #:prefix license:) 3 | #:use-module (guix download) 4 | #:use-module (guix packages) 5 | #:use-module (gnu packages) 6 | #:use-module (gnu packages ruby) 7 | #:use-module (gnu packages rails) 8 | #:use-module (guix build-system ruby)) 9 | 10 | (define-public ruby-bootstrap-sass 11 | (package 12 | (name "ruby-bootstrap-sass") 13 | (version "3.4.1") ; ruby-govuk-admin-template requires this version 14 | (source 15 | (origin 16 | (method url-fetch) 17 | (uri (rubygems-uri "bootstrap-sass" version)) 18 | (sha256 19 | (base32 20 | "1py78mv97c1m2w59s1h7fvs34j4hh66yln5275537a5hbr9p6ims")))) 21 | (build-system ruby-build-system) 22 | (arguments 23 | '(#:tests? #f)) 24 | (propagated-inputs 25 | `(("ruby-autoprefixer-rails" ,ruby-autoprefixer-rails) 26 | ("ruby-sassc" ,ruby-sassc))) 27 | (synopsis "Sass-powered version of Bootstrap 3") 28 | (description 29 | "bootstrap-sass is a Sass-powered version of Bootstrap 3, ready to drop right into your Sass powered applications.") 30 | (home-page "https://github.com/twbs/bootstrap-sass") 31 | (license license:expat))) 32 | 33 | (define-public ruby-jquery-rails 34 | (package 35 | (name "ruby-jquery-rails") 36 | (version "4.3.1") 37 | (source 38 | (origin 39 | (method url-fetch) 40 | (uri (rubygems-uri "jquery-rails" version)) 41 | (sha256 42 | (base32 43 | "02ii77vwxc49f2lrkbdzww2168bp5nihwzakc9mqyrsbw394w7ki")))) 44 | (build-system ruby-build-system) 45 | (arguments 46 | '(#:tests? #f)) 47 | (native-inputs 48 | `(("bundler" ,bundler))) 49 | (propagated-inputs 50 | `(("ruby-rails-dom-testing" ,ruby-rails-dom-testing) 51 | ("ruby-railties" ,ruby-railties) 52 | ("ruby-thor" ,ruby-thor))) 53 | (synopsis "jQuery and the jQuery-ujs driver for your Rails") 54 | (description 55 | "This gem provides jQuery and the jQuery-ujs driver for your Rails 4+ 56 | application.") 57 | (home-page "http://rubygems.org/gems/jquery-rails") 58 | (license license:expat))) 59 | -------------------------------------------------------------------------------- /gds/services/base.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds services base) 2 | #:use-module (srfi srfi-1) 3 | #:use-module (gnu services) 4 | #:use-module (gnu services shepherd) 5 | #:use-module (gnu system shadow) 6 | #:use-module ((gnu packages admin) 7 | #:select (shadow)) 8 | #:use-module (guix records) 9 | #:use-module (guix gexp) 10 | #:use-module (ice-9 match) 11 | #:use-module (guix packages) 12 | #:use-module (gnu packages base) 13 | #:use-module (gnu packages databases) 14 | #:use-module (gds packages govuk) 15 | #:export (pretend-loopback-service 16 | set-file-ownership-service-type)) 17 | 18 | (define pretend-loopback-service 19 | (service 20 | (shepherd-service-type 21 | 'dummy-loopback-service 22 | (const 23 | (shepherd-service 24 | (documentation "Pretend loopback service, just provides 'loopback") 25 | (provision '(loopback networking)) 26 | (start #~(const #t)) 27 | (stop #~(const #t))))) 28 | '())) 29 | 30 | (define set-file-ownership-service-type 31 | (service-type 32 | (name 'set-file-ownership) 33 | (extensions 34 | (list (service-extension 35 | activation-service-type 36 | (lambda (paths-and-owners) 37 | #~(begin 38 | (use-modules (ice-9 match)) 39 | (for-each 40 | (match-lambda 41 | ((path user group options ...) 42 | (if (file-exists? path) 43 | (let 44 | ((command 45 | `(,#$(file-append coreutils "/bin/chown") 46 | ,(simple-format #f "~A:~A" user group) 47 | ,@(if (memq #:recursive options) '("-R") '()) 48 | ,path))) 49 | (simple-format #t "Changing owner of ~A to ~A:~A\n" 50 | path user group) 51 | (simple-format #t "Running command: ~A\n" (string-join command)) 52 | (apply system* command)) 53 | (simple-format #t "Skipping ~A as it does not exist\n" path)))) 54 | '#$paths-and-owners)))))) 55 | (compose concatenate) 56 | (extend append))) 57 | -------------------------------------------------------------------------------- /gds/services/sidekiq.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds services sidekiq) 2 | #:use-module (srfi srfi-1) 3 | #:use-module (ice-9 match) 4 | #:use-module (guix gexp) 5 | #:use-module (guix records) 6 | #:use-module (guix packages) 7 | #:use-module (gnu services shepherd) 8 | #:use-module (gds services) 9 | #:export ( 10 | sidekiq-config 11 | sidekiq-config? 12 | sidekiq-config-file 13 | 14 | sidekiq-shepherd-service)) 15 | 16 | (define-record-type* 17 | sidekiq-config make-sidekiq-config 18 | sidekiq-config? 19 | (file sidekiq-config-file 20 | (default #f))) 21 | 22 | (define (sidekiq-shepherd-service 23 | name 24 | sidekiq-config 25 | requirements 26 | directory 27 | user 28 | environment) 29 | (let* 30 | ((config-file (sidekiq-config-file sidekiq-config)) 31 | (pidfile (string-append "/tmp/" name ".pid")) 32 | (start-command 33 | `(,(string-append directory "/bin/bundle") 34 | "exec" 35 | "sidekiq" 36 | ,@(if config-file `("-C" ,config-file) '()) 37 | "--pidfile" ,pidfile))) 38 | (shepherd-service 39 | (provision (list (string->symbol name))) 40 | (documentation 41 | (simple-format #f "~A service" name)) 42 | (requirement requirements) 43 | (respawn? #f) 44 | (start #~(lambda args 45 | (display 46 | #$(simple-format #f "starting ~A service: ~A\n" 47 | name (string-join start-command))) 48 | (apply 49 | #$#~(make-forkexec-constructor 50 | '#$start-command 51 | #:user #$user 52 | #:pid-file #$pidfile 53 | #:pid-file-timeout 60 54 | #:log-file #$(string-append "/var/log/" name".log") 55 | #:directory #$directory 56 | #:environment-variables 57 | '#$(map 58 | (match-lambda 59 | ((key . value) 60 | (string-append key "=" value))) 61 | environment)) 62 | args))) 63 | (stop #~(make-kill-destructor))))) 64 | -------------------------------------------------------------------------------- /gds/data/tar-archive.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds data tar-archive) 2 | #:use-module (ice-9 match) 3 | #:use-module (guix gexp) 4 | #:use-module (guix store) 5 | #:use-module (guix packages) 6 | #:use-module (guix records) 7 | #:use-module (guix monads) 8 | #:use-module (gnu packages base) 9 | #:use-module (gnu packages compression) 10 | #:export ( 11 | tar-archive 12 | tar-archive? 13 | tar-archive-name 14 | tar-archive-contents)) 15 | 16 | (define-record-type* 17 | tar-archive make-tar-archive 18 | tar-archive? 19 | (name tar-archive-name) 20 | (contents tar-archive-contents)) 21 | 22 | (define-gexp-compiler (tar-extract-compiler 23 | (tar-extract ) system target) 24 | (match tar-extract 25 | (($ name contents) 26 | (mlet %store-monad ((guile (package->derivation (default-guile) system))) 27 | 28 | (define inputs (list gzip xz)) 29 | 30 | (define build 31 | (with-imported-modules `((guix build utils)) 32 | #~(let* ((tar-command 33 | (list 34 | (string-append #$tar "/bin/tar") 35 | "--checkpoint=20000" 36 | "--checkpoint-action=echo='%ds: %{read,wrote}T'" 37 | "--create" 38 | "--verbose" 39 | "--auto-compress" 40 | "--file" 41 | #$output 42 | "--directory" 43 | #$contents 44 | "."))) 45 | (use-modules (srfi srfi-1) 46 | (ice-9 ftw) 47 | (guix build utils)) 48 | (setenv "XZ_OPT" "-9 -T0") 49 | (set-path-environment-variable 50 | "PATH" '("bin" "sbin") '#+inputs) 51 | 52 | (simple-format #t "\nrunning ~A\n" (string-join tar-command)) 53 | (force-output) 54 | (let ((status (apply system* tar-command))) 55 | (unless (zero? status) 56 | (exit 1)))))) 57 | 58 | (gexp->derivation name build 59 | #:system system 60 | #:local-build? #t 61 | #:recursive? #t 62 | #:guile-for-build guile))))) 63 | -------------------------------------------------------------------------------- /guix-pre-inst-env: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | if [ ! -n "$BASH" ] ; then 6 | exec bash "$0" "$@" 7 | fi 8 | 9 | export GOVUK_GUIX_ROOT="$(readlink -f $(dirname ${BASH_SOURCE[0]}))" 10 | export GUIX_PACKAGE_PATH="$GOVUK_GUIX_ROOT/.guix-package-path" 11 | 12 | if [[ $# -eq 0 ]] ; then 13 | cat < (postgresql-configuration 17 | (inherit config) 18 | (config-file 19 | (postgresql-config-file 20 | (inherit (postgresql-configuration-file config)) 21 | (extra-config 22 | '(("session_preload_libraries" "'auto_explain'") 23 | ("auto_explain.log_min_duration" "'500ms'"))))))))) 24 | 25 | (define setup-services-for-development-os 26 | (let 27 | ((service-setup-functions 28 | ;; Service setup functions, order alphabetically if possible, 29 | ;; and add comments to indicate any interdependencies in the 30 | ;; configuration 31 | (list 32 | setup-other-services 33 | (cut map 34 | (cut update-rails-app-config-environment-for-service "development" <>) 35 | <>) 36 | (cut map 37 | (cut update-service-database-connection-config-for-environment "development" <>) 38 | <>) 39 | (cut set-routing-configuration-for-services <> 40 | #:use-high-ports? #t 41 | #:use-https? #f 42 | #:app-domain "dev.gov.uk" 43 | #:web-domain "dev.gov.uk") 44 | ;; TODO: ensure-database-user-exists-on-service-startup and 45 | ;; configure-rails-services-database setup must happen after 46 | ;; update-database-connection-config-ports, or the wrong 47 | ;; database connection configuration is used. 48 | (cut map ensure-database-user-exists-on-service-startup <>) 49 | (cut map run-db:setup-if-postgresql-or-mysql-is-used <>)))) 50 | 51 | (apply compose (reverse service-setup-functions)))) 52 | 53 | (define govuk-development-os 54 | (operating-system 55 | (inherit govuk-production-os) 56 | (host-name "govuk-development") 57 | (services (setup-services-for-development-os 58 | (operating-system-user-services govuk-production-os))))) 59 | 60 | govuk-development-os 61 | -------------------------------------------------------------------------------- /gds/build-jobs/govuk.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds build-jobs govuk) 2 | #:use-module (srfi srfi-1) 3 | #:use-module (srfi srfi-19) 4 | #:use-module (srfi srfi-34) 5 | #:use-module (srfi srfi-35) 6 | #:use-module (ice-9 match) 7 | #:use-module (ice-9 popen) 8 | #:use-module (ice-9 rdelim) 9 | #:use-module (guix config) 10 | #:use-module (guix grafts) 11 | #:use-module (guix store) 12 | #:use-module (guix packages) 13 | #:use-module (guix derivations) 14 | #:use-module (guix discovery) 15 | #:use-module (gnu packages) 16 | #:export (govuk-packages-jobs)) 17 | 18 | (define (package-metadata package) 19 | `((#:description . ,(package-synopsis package)) 20 | (#:long-description . ,(package-description package)) 21 | (#:home-page . ,(package-home-page package)) 22 | (#:maintainers . ("govuk-developers")) 23 | (#:max-silent-time . ,(or (assoc-ref (package-properties package) 24 | 'max-silent-time) 25 | 3600)) ;1 hour by default 26 | (#:timeout . ,(or (assoc-ref (package-properties package) 'timeout) 27 | 72000)))) ;20 hours by default 28 | 29 | (define (package-job store job-name package system) 30 | "Return a job called JOB-NAME that builds PACKAGE on SYSTEM." 31 | `((#:job-name . ,(string-append (symbol->string job-name) "." system)) 32 | (#:derivation . ,(derivation-file-name 33 | (parameterize ((%graft? #f)) 34 | (package-derivation store package system 35 | #:graft? #f)))) 36 | ,@(package-metadata package))) 37 | 38 | (define job-name 39 | ;; Return the name of a package's job. 40 | (compose string->symbol package-full-name)) 41 | 42 | (define (package->job store package system) 43 | (package-job store (job-name package) package system)) 44 | 45 | (define (govuk-packages-jobs store) 46 | (parameterize ((%graft? #f)) 47 | (let* ((modules 48 | (filter (lambda (module) 49 | (match (module-name module) 50 | (('gds 'packages 'govuk rest ...) #t) 51 | (_ #f))) 52 | (all-modules 53 | (list 54 | (string-append 55 | (getenv "GOVUK_GUIX_ROOT") 56 | "/.guix-package-path"))))) 57 | (pkgs 58 | (fold-packages cons 59 | '() 60 | modules))) 61 | (filter-map (lambda (pkg) 62 | (package->job store pkg "x86_64-linux")) 63 | pkgs)))) 64 | -------------------------------------------------------------------------------- /gds/systems/govuk/utils.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds systems govuk utils) 2 | #:use-module (srfi srfi-1) 3 | #:use-module (ice-9 match) 4 | #:use-module (guix gexp) 5 | #:use-module (gnu services) 6 | #:use-module (gnu system shadow) 7 | #:use-module (gds services utils databases) 8 | #:use-module (gds services utils databases elasticsearch) 9 | #:use-module (gds services utils databases mongodb) 10 | #:use-module (gds services utils databases mysql) 11 | #:use-module (gds services utils databases postgresql) 12 | #:export (govuk-skeletons-service-type)) 13 | 14 | (define (govuk-skeletons redis-connection-config 15 | memcached-connection-config 16 | postgresql-connection-config) 17 | (define pair->alias 18 | (match-lambda 19 | ((name . value) 20 | (simple-format #f "alias ~A=\"~A\"\n" name value)))) 21 | 22 | `((".psqlrc" ,(local-file "skeletons/psqlrc")) 23 | (".bashrc" ,(local-file "skeletons/bashrc")) 24 | (".bash_aliases" 25 | ,(plain-file 26 | "aliases" 27 | (string-concatenate 28 | (map pair->alias 29 | `(("redis" . 30 | ,(string-append 31 | "redis-cli -p " 32 | (number->string 33 | (redis-connection-config-port redis-connection-config)))) 34 | ("memcached-telnet" . 35 | ,(string-append 36 | "telnet " 37 | (number->string 38 | (memcached-connection-config-port memcached-connection-config))))))))) 39 | (".environment" 40 | ,(plain-file 41 | "environment" 42 | (apply 43 | string-append 44 | (map (match-lambda 45 | ((name . value) 46 | (simple-format #f "export ~A=~A\n" name value))) 47 | `(("PGPORT" . ,(postgresql-connection-config-port 48 | postgresql-connection-config)) 49 | ("PGUSER" . "postgres") 50 | ("PAGER" . "less") 51 | ("LC_ALL" . "en_GB.UTF-8")))))))) 52 | 53 | (define govuk-skeletons-service-type 54 | (service-type 55 | (name 'govuk-skeletons) 56 | (extensions 57 | (list 58 | (service-extension account-service-type 59 | (lambda (parameters) 60 | (govuk-skeletons 61 | (find redis-connection-config? parameters) 62 | (find memcached-connection-config? parameters) 63 | (find postgresql-connection-config? parameters)))))) 64 | (default-value 65 | (list 66 | (redis-connection-config) 67 | (memcached-connection-config) 68 | (postgresql-connection-config 69 | (user #f) (database #f)))))) 70 | -------------------------------------------------------------------------------- /gds/systems/govuk/publishing-e2e-tests.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds systems govuk publishing-e2e-tests) 2 | #:use-module (srfi srfi-1) 3 | #:use-module (srfi srfi-26) 4 | #:use-module (guix gexp) 5 | #:use-module (gnu system) 6 | #:use-module (gnu packages certs) 7 | #:use-module (gnu packages tls) 8 | #:use-module (gnu services) 9 | #:use-module (gnu services web) 10 | #:use-module (gds packages govuk) 11 | #:use-module (gds services) 12 | #:use-module (gds services rails) 13 | #:use-module (gds services utils) 14 | #:use-module (gds services utils databases) 15 | #:use-module (gds services utils databases postgresql) 16 | #:use-module (gds services utils databases mysql) 17 | #:use-module (gds services utils databases mongodb) 18 | #:use-module (gds services govuk) 19 | #:use-module (gds services govuk signon) 20 | #:use-module (gds services govuk nginx) 21 | #:use-module (gds services govuk router) 22 | #:use-module (gds services govuk plek) 23 | #:use-module (gds services govuk publishing-e2e-tests) 24 | #:use-module (gds services govuk routing-configuration) 25 | #:use-module (gds systems utils) 26 | #:use-module (gds systems govuk base) 27 | #:use-module (gds systems govuk test) 28 | #:export (publishing-e2e-tests-os)) 29 | 30 | (define services 31 | (modify-services 32 | (operating-system-user-services govuk-test-os) 33 | (govuk-nginx-service-type 34 | parameter => 35 | (govuk-nginx-configuration 36 | (inherit parameter) 37 | (additional-nginx-server-blocks 38 | (list 39 | (nginx-server-configuration 40 | (server-name '("publishing-e2e-tests.dev.gov.uk")) 41 | (root "/var/apps/publishing-e2e-tests") 42 | (locations 43 | (list 44 | (nginx-location-configuration 45 | (uri "/") 46 | (body '("autoindex on;")))))))))))) 47 | 48 | (define plek-config 49 | (any (lambda (service) 50 | (and (list? (service-value service)) 51 | (find plek-config? (service-value service)))) 52 | (operating-system-user-services govuk-test-os))) 53 | 54 | (define publishing-e2e-tests-os 55 | (system-without-unnecessary-services 56 | (cons* (find (lambda (s) (eq? (service-kind s) 57 | publishing-e2e-tests-service-type)) 58 | services) 59 | ;; TODO: Currently nothing depends on authenticating-proxy, 60 | ;; so its removed 61 | (find (lambda (s) (eq? (service-type-name (service-kind s)) 62 | 'authenticating-proxy)) 63 | services) 64 | (filter (lambda (s) 65 | (memq (service-kind s) 66 | (map service-kind base-services))) 67 | services)) 68 | (operating-system 69 | (inherit govuk-test-os) 70 | (services services) 71 | (hosts-file 72 | (plek-config->hosts-file plek-config))))) 73 | 74 | publishing-e2e-tests-os 75 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+BEGIN_QUOTE 2 | * 🚨 Deprecated 3 | 4 | *This repository is no longer maintained and should not be used.* 5 | 6 | We now [[https://github.com/alphagov/govuk-docker][use Docker for local development]]. For more context, see [[https://github.com/alphagov/govuk-rfcs/blob/main/rfc-106-docker-for-local-development.md][GOV.UK RFC-106]]. 7 | #+END_QUOTE 8 | 9 | ----- 10 | 11 | * Getting started 12 | 13 | See [[doc/installation.md][doc/installation.md]] for a full list of [[doc/installation.md#prerequisites][prerequisites]] and 14 | [[doc/installation.md#steps][steps]]. The most reliable way to run the included scripts is via the 15 | included govuk script. The bin directory can be added to your PATH for 16 | easy access, for example: 17 | 18 | #+BEGIN_SRC shell 19 | export PATH="$PATH:$PWD/bin" 20 | #+END_SRC 21 | 22 | ** Local Development 23 | 24 | You can use govuk-guix to run GOV.UK services on your computer, for 25 | example, to start a system with the Short URL Manager, Specialist 26 | Publisher and any of their dependencies, you would run: 27 | 28 | #+BEGIN_SRC shell 29 | govuk system start short-url-manager specialist-publisher 30 | #+END_SRC 31 | 32 | To find out more, read the documentation on [[doc/local-development.md][local development]]. 33 | 34 | ** Local Data 35 | 36 | You can use govuk-guix to list and load data downloaded through the 37 | replication scripts in the govuk-puppet repository, for example, to 38 | load the data for the short-url-manager service, you would run: 39 | 40 | #+BEGIN_SRC shell 41 | govuk data load short-url-manager 42 | #+END_SRC 43 | 44 | To find out more, read the documentation on [[doc/local-data.md][local data]]. 45 | 46 | * Why Guix? 47 | 48 | [[http://www.gnu.org/software/guix/][GNU Guix]] (abbreviated to Guix) (IPA: /ɡiːks/) is a package manager, 49 | and associated free software distribution, for the [[http://www.gnu.org/gnu/gnu.html][GNU system]]. 50 | 51 | Guix is a state of the art package manager, providing many features, 52 | such as reproducible build environments, unprivileged package 53 | management, transparent source/binary deployment and per-user 54 | profiles. 55 | 56 | The design and low level mechanisms of Guix come from the Nix package 57 | manager, on top of which Guix provides a hackable set of tooling using 58 | Guile. 59 | 60 | This project leverages Guix, building on top of its tooling to provide 61 | packages, services and systems relevant to GOV.UK. 62 | 63 | * Hacking 64 | 65 | When developing locally, you may find it useful to use a local copy of 66 | GNU Guix, this can be done by setting the GDS_GNU_GUIX_MODULE_PATH 67 | environment variable, for example: 68 | 69 | #+BEGIN_SRC shell 70 | export GDS_GNU_GUIX_MODULE_PATH="../gnu-guix" 71 | #+END_SRC 72 | 73 | The value of GDS_GNU_GUIX_MODULE_PATH will be prepended to the 74 | GUILE_LOAD_PATH and GUILE_LOAD_COMPILED_PATH. 75 | 76 | To replace the package source for the guix package within the 77 | govuk-guix repository, you can set the GDS_GNU_GUIX_PATH environment 78 | variable. 79 | 80 | #+BEGIN_SRC shell 81 | export GDS_GNU_GUIX_PATH="../gnu-guix" 82 | #+END_SRC 83 | -------------------------------------------------------------------------------- /gds/data/transformations.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds data transformations) 2 | #:use-module (ice-9 match) 3 | #:use-module (guix gexp) 4 | #:use-module (guix store) 5 | #:use-module (guix monads) 6 | #:use-module (guix records) 7 | #:use-module (guix packages) 8 | #:export ( 9 | data-transformation 10 | data-transformation? 11 | data-transformation-output-name 12 | data-transformation-output-description 13 | data-transformation-operation 14 | 15 | 16 | multi-output-data-transformation 17 | multi-output-data-transformation? 18 | multi-output-data-transformation-name 19 | multi-output-data-transformation-outputs 20 | multi-output-data-transformation-operation 21 | 22 | 23 | gexp-output-alias 24 | gexp-output-alias 25 | gexp-output-alias-gexp 26 | gexp-output-alias-output)) 27 | 28 | (define-record-type* 29 | data-transformation make-data-transformation 30 | data-transformation? 31 | (output-name data-transformation-output-name) 32 | (output-description data-transformation-output-description 33 | (default #f)) 34 | (operation data-transformation-operation)) 35 | 36 | (define-gexp-compiler (data-transformation-compiler 37 | (data-transformation ) 38 | system target) 39 | (match data-transformation 40 | (($ output-name output-description 41 | operation) 42 | 43 | (gexp->derivation output-name operation 44 | #:system system)))) 45 | 46 | (define-record-type* 47 | multi-output-data-transformation make-multi-output-data-transformation 48 | multi-output-data-transformation? 49 | (name multi-output-data-transformation-name) 50 | (outputs multi-output-data-transformation-outputs) 51 | (operation multi-output-data-transformation-operation)) 52 | 53 | (define-gexp-compiler (multi-output-data-transformation-compiler 54 | (multi-output-data-transformation 55 | ) 56 | system target) 57 | (match multi-output-data-transformation 58 | (($ name outputs operation) 59 | 60 | (gexp->derivation name 61 | operation 62 | #:system system)))) 63 | 64 | (define-record-type* 65 | gexp-output-alias make-gexp-output-alias 66 | gexp-output-alias? 67 | (gexp gexp-output-alias-gexp) 68 | (output gexp-output-alias-output)) 69 | 70 | (define-gexp-compiler (gexp-output-alias-compiler 71 | (gexp-output-alias ) 72 | system target) 73 | (match gexp-output-alias 74 | (($ aliased-gexp output-name) 75 | 76 | (gexp->derivation (string-append "output-alias-" output-name) 77 | #~(symlink (ungexp aliased-gexp output-name) 78 | #$output) 79 | #:system system)))) 80 | -------------------------------------------------------------------------------- /gds/scripts/govuk/data/list.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds scripts govuk data list) 2 | #:use-module (srfi srfi-1) 3 | #:use-module (srfi srfi-11) 4 | #:use-module (srfi srfi-19) 5 | #:use-module (srfi srfi-37) 6 | #:use-module (ice-9 format) 7 | #:use-module (ice-9 match) 8 | #:use-module (guix gexp) 9 | #:use-module (guix store) 10 | #:use-module (guix monads) 11 | #:use-module (guix derivations) 12 | #:use-module (gnu services) 13 | #:use-module (gnu services databases) 14 | #:use-module (gds services govuk) 15 | #:use-module (gds services utils databases postgresql) 16 | #:use-module (gds services utils databases mysql) 17 | #:use-module (gds data govuk) 18 | #:use-module (gds data data-extract) 19 | #:use-module (gds data data-source) 20 | #:use-module (gds data transformations) 21 | #:use-module (gds data transformations postgresql) 22 | #:use-module (gds data transformations mysql) 23 | #:export (list-available-extracts)) 24 | 25 | (define* (list-available-extracts services data-extracts 26 | #:key dry-run? verbose? max-jobs) 27 | (for-each 28 | (match-lambda 29 | ((service-type . data-extracts) 30 | (if (member service-type (map service-kind services)) 31 | (begin 32 | (simple-format #t "service: ~A\n" (service-type-name 33 | service-type)) 34 | (for-each 35 | (match-lambda 36 | ((database . data-extracts) 37 | (simple-format #t " database: ~A\n" database) 38 | (for-each 39 | (match-lambda 40 | ((date . data-extracts) 41 | (simple-format 42 | #t " - ~A\n" 43 | (date->string date "~d/~m/~Y")) 44 | (if (or verbose? 45 | (> (length data-extracts) 1)) 46 | (for-each 47 | (lambda (data-extract priority-ordering) 48 | (let ((data-source 49 | (data-extract-data-source 50 | data-extract))) 51 | (format 52 | #t 53 | " - ~A: ~A ~A (~:r priority)\n" 54 | (data-extract-variant-name data-extract) 55 | (data-extract-variant-label data-extract) 56 | (data-source-name data-source) 57 | priority-ordering))) 58 | ;; Highest priority first, so reverse the sort order 59 | (reverse (sort-extracts data-extracts)) 60 | (iota (length data-extracts) 1))))) 61 | (group-extracts data-extract-datetime data-extracts)))) 62 | (group-extracts data-extract-database data-extracts)))))) 63 | (stable-sort 64 | (group-extracts data-extract-services 65 | (sort-extracts data-extracts)) 66 | (match-lambda* (((service-type1 . data-extracts1) 67 | (service-type2 . data-extracts2)) 68 | (stringstring 69 | (service-type-name service-type1)) 70 | (symbol->string 71 | (service-type-name service-type2)))))))) 72 | -------------------------------------------------------------------------------- /gds/packages/third-party/phantomjs.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds packages third-party phantomjs) 2 | #:use-module (guix packages) 3 | #:use-module (gnu packages base) 4 | #:use-module (gnu packages compression) 5 | #:use-module (gnu packages bootstrap) 6 | #:use-module (gnu packages elf) 7 | #:use-module (gnu packages bash) 8 | #:use-module (gnu packages gcc) 9 | #:use-module (gnu packages fontutils) 10 | #:use-module (guix build-system trivial) 11 | #:use-module (guix build-system gnu) 12 | #:use-module ((guix licenses) #:prefix license:) 13 | #:use-module (guix download)) 14 | 15 | (define-public phantomjs 16 | (package 17 | (name "phantomjs") 18 | (version "2.1.1") 19 | (source 20 | (origin 21 | (method url-fetch) 22 | (uri (string-append 23 | "https://bitbucket.org/ariya/phantomjs/downloads/phantomjs-" version "-linux-x86_64.tar.bz2")) 24 | (file-name (string-append name "-" version ".tar.bz2")) 25 | (sha256 26 | (base32 "0bqd8r97inh5f682m3cykg76s7bwjkqirxn9hhd5zr5fyi5rmpc6")))) 27 | (build-system trivial-build-system) 28 | (arguments 29 | `(#:modules ((guix build utils)) 30 | #:builder 31 | (begin 32 | (use-modules (guix build utils)) 33 | (let ((source (assoc-ref %build-inputs "source")) 34 | (out (assoc-ref %outputs "out")) 35 | (bzip2 (assoc-ref %build-inputs "bzip2")) 36 | (tar (assoc-ref %build-inputs "tar")) 37 | (patchelf (string-append 38 | (assoc-ref %build-inputs "patchelf") "/bin/patchelf")) 39 | (ld-so (string-append (assoc-ref %build-inputs "libc") 40 | ,(glibc-dynamic-linker)))) 41 | (mkdir-p out) 42 | (setenv "PATH" (string-append bzip2 "/bin")) 43 | (chdir out) 44 | (zero? 45 | (system* 46 | (string-append tar "/bin/tar") 47 | "--extract" 48 | "-f" 49 | source 50 | "--strip" "1" 51 | "--wildcards" 52 | "*/bin/phantomjs")) 53 | (system* patchelf "--set-interpreter" ld-so (string-append out "/bin/phantomjs")) 54 | (let* 55 | ((libs '("gcc:lib" "zlib" "fontconfig" "freetype")) 56 | (ld-library-path 57 | (map 58 | (lambda (lib) 59 | (string-append 60 | (assoc-ref %build-inputs lib) 61 | "/lib")) 62 | libs))) 63 | (setenv "PATH" (string-append 64 | (assoc-ref %build-inputs "bash") 65 | "/bin")) 66 | (wrap-program 67 | (string-append out "/bin/phantomjs") 68 | `("LD_LIBRARY_PATH" = (,(string-join 69 | ld-library-path 70 | ":"))))))))) 71 | (native-inputs 72 | `(("tar" ,tar) 73 | ("bzip2" ,bzip2) 74 | ("patchelf" ,patchelf) 75 | ("libc" ,glibc))) 76 | (inputs 77 | `(("zlib" ,zlib) 78 | ("fontconfig" ,fontconfig) 79 | ("freetype" ,freetype) 80 | ("gcc:lib" ,gcc-4.9 "lib") 81 | ("bash" ,bash))) 82 | (home-page "http://phantomjs.org/") 83 | (synopsis "") 84 | (description "") 85 | (license license:bsd-3))) 86 | -------------------------------------------------------------------------------- /gds/services/govuk/router.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds services govuk router) 2 | #:use-module (srfi srfi-1) 3 | #:use-module (ice-9 match) 4 | #:use-module (guix records) 5 | #:use-module (guix gexp) 6 | #:use-module (gnu services) 7 | #:use-module (gnu services shepherd) 8 | #:use-module (gds services utils databases) 9 | #:export ( 10 | router-config 11 | router-config? 12 | router-config-public-port 13 | router-config-api-port 14 | 15 | router-config->environment-variables 16 | make-router-shepherd-service 17 | make-router-service-type)) 18 | 19 | (define-record-type* 20 | router-config make-router-config 21 | router-config? 22 | (public-port router-config-public-port 23 | (default 8080)) 24 | (api-port router-config-api-port 25 | (default 8081)) 26 | (debug? router-config-debug 27 | (default #f)) 28 | (backend-connect-timeout router-config-backend-connect-timeout 29 | (default "1s")) 30 | (backend-header-timeout router-config-backend-header-timeout 31 | (default "15s"))) 32 | 33 | (define router-config->environment-variables 34 | (match-lambda 35 | (($ public-port api-port debug? 36 | backend-connect-timeout backend-header-timeout) 37 | (append 38 | (list 39 | (cons "ROUTER_PUBADDR" (simple-format #f ":~A" public-port)) 40 | (cons "ROUTER_APIADDR" (simple-format #f ":~A" api-port)) 41 | (cons "ROUTER_BACKEND_CONNECT_TIMEOUT" backend-connect-timeout) 42 | (cons "ROUTER_BACKEND_HEADER_TIMEOUT" backend-header-timeout)) 43 | (if debug? 44 | (list (cons "DEBUG" "true")) 45 | '()))))) 46 | 47 | (define (make-router-shepherd-service name) 48 | (match-lambda 49 | ((router-config package rest ...) 50 | (let ((environment-variables 51 | (map 52 | (match-lambda 53 | ((key . value) 54 | (string-append key "=" value))) 55 | (map 56 | (match-lambda 57 | ((name . value) 58 | (cond 59 | ((string=? name "MONGO_DB") 60 | (cons "ROUTER_MONGO_DB" value)) 61 | ((string=? name "MONGODB_URI") 62 | (cons "ROUTER_MONGO_URL" value)) 63 | (else 64 | (cons name value))))) 65 | (append 66 | (router-config->environment-variables router-config) 67 | (concatenate 68 | (map database-connection-config->environment-variables 69 | (filter database-connection-config? rest))))))) 70 | (string-service-name 71 | (symbol->string name))) 72 | (list 73 | (shepherd-service 74 | (provision (list name)) 75 | (documentation string-service-name) 76 | (requirement '(mongodb)) 77 | (respawn? #f) 78 | (start #~(make-forkexec-constructor 79 | (list (string-append #$package "/bin/router")) 80 | #:user (passwd:uid (getpwnam "nobody")) 81 | #:environment-variables '#$environment-variables 82 | #:log-file (string-append "/var/log/" #$string-service-name))) 83 | (stop #~(make-kill-destructor)))))))) 84 | 85 | (define (make-router-service-type name 86 | default-value) 87 | (service-type 88 | (name name) 89 | (extensions 90 | (list (service-extension shepherd-root-service-type 91 | (make-router-shepherd-service name)))) 92 | (default-value 93 | default-value))) 94 | -------------------------------------------------------------------------------- /gds/services/govuk/tls.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds services govuk tls) 2 | #:use-module (guix gexp) 3 | #:use-module (guix packages) 4 | #:use-module (guix build-system trivial) 5 | #:use-module (gnu packages tls) 6 | #:use-module (gnu packages perl) 7 | #:use-module (gnu packages certs) 8 | #:export (development-os-tls-private-key 9 | development-os-tls-certificate 10 | development-os-certificates-package-for-domains)) 11 | 12 | (define development-os-tls-private-key 13 | (computed-file 14 | "dev.gov.uk.key" 15 | #~(let ((certtool (string-append 16 | #$gnutls "/bin/certtool"))) 17 | (zero? 18 | (system* 19 | certtool 20 | "--generate-privkey" 21 | "--provable" 22 | "--seed=00000000" 23 | "--outfile" #$output))) 24 | #:options '(#:local-build? #t 25 | #:substitutable? #f))) 26 | 27 | (define (development-os-tls-certificate-template dns-names) 28 | (plain-file 29 | "dev.gov.uk.cert.template" 30 | (string-append 31 | "# The organization of the subject. 32 | organization = \"govuk-guix development certificate\" 33 | 34 | # In how many days, counting from today, this certificate will expire. 35 | expiration_days = 365 36 | 37 | " 38 | (string-join 39 | (map (lambda (name) 40 | (string-append "dns_name = " name)) 41 | dns-names) 42 | "\n") 43 | " 44 | 45 | # Whether this certificate will be used for a TLS server 46 | tls_www_server 47 | 48 | # Whether this certificate will be used to encrypt data (needed 49 | # in TLS RSA ciphersuites). Note that it is preferred to use different 50 | # keys for encryption and signing. 51 | encryption_key 52 | 53 | ca 54 | 55 | cert_signing_key"))) 56 | 57 | (define (development-os-tls-certificate dns-names) 58 | (computed-file 59 | "dev.gov.uk.pem" 60 | #~(let ((certtool (string-append 61 | #$gnutls "/bin/certtool"))) 62 | (zero? 63 | (system* 64 | certtool 65 | "--generate-self-signed" 66 | "--load-privkey" #$development-os-tls-private-key 67 | "--template" 68 | #$(development-os-tls-certificate-template dns-names) 69 | "--outfile" #$output))) 70 | #:options '(#:local-build? #t 71 | #:substitutable? #f))) 72 | 73 | (define (development-os-certificates-package-for-domains dns-names) 74 | (package 75 | (name "govuk-development-certificates") 76 | (version "0") 77 | (source (development-os-tls-certificate dns-names)) 78 | (build-system trivial-build-system) 79 | (arguments 80 | '(#:modules ((guix build utils)) 81 | #:builder 82 | (let ((dest 83 | (string-append 84 | (assoc-ref %outputs "out") 85 | "/etc/ssl/certs/dev.gov.uk.pem"))) 86 | (use-modules (guix build utils)) 87 | (mkdir-p (dirname dest)) 88 | (copy-recursively 89 | (assoc-ref %build-inputs "source") 90 | dest) 91 | (setenv "PATH" 92 | (string-append 93 | (getenv "PATH") 94 | ":" 95 | (assoc-ref %build-inputs "perl") "/bin")) 96 | (with-directory-excursion (dirname dest) 97 | (or (zero? 98 | (system* (string-append 99 | (assoc-ref %build-inputs "openssl") 100 | "/bin/c_rehash") 101 | ".")) 102 | (error "couldn't rehash")))))) 103 | (native-inputs 104 | `(("perl" ,perl) 105 | ("openssl" ,openssl))) 106 | (home-page "") 107 | (synopsis "") 108 | (description "") 109 | (license #f))) 110 | 111 | -------------------------------------------------------------------------------- /bin/govuk-download-backups: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -e 4 | 5 | if [ ! -n "$BASH" ] ; then 6 | exec bash "$0" $@ 7 | fi 8 | 9 | eval "$(govuk aws --profile govuk-integration --export)" 10 | 11 | BACKUPS="$GDS_GUIX_GOVUK_PUPPET_BACKUPS_DIRECTORY" 12 | DATE="$(date '+%Y-%m-%d')" 13 | 14 | # 15 | # Download PostgreSQL and MySQL backups 16 | # 17 | 18 | aws s3 sync s3://govuk-integration-database-backups/postgres/$DATE/ "$BACKUPS/$DATE/postgresql/" 19 | aws s3 sync s3://govuk-integration-database-backups/mysql/$DATE/ "$BACKUPS/$DATE/mysql/mysql-master/" 20 | 21 | # 22 | # Download MongoDB backups 23 | # 24 | 25 | MONGODB_HOSTNAMES=(router_backend mongo) 26 | MONGODB_FILES=() 27 | 28 | for SRC_HOSTNAME in "${MONGODB_HOSTNAMES[@]}" 29 | do 30 | echo "$SRC_HOSTNAME" 31 | remote_file_details=$(aws s3 ls s3://govuk-integration-database-backups/mongodb/daily/${SRC_HOSTNAME}/ | grep "$DATE" || true) 32 | if [ -z "$remote_file_details" ]; then 33 | echo "missing $DATE for $SRC_HOSTNAME" 34 | MONGODB_FILES+=("") 35 | continue 36 | fi 37 | arr_file_details=($remote_file_details) 38 | FILE_NAME=${arr_file_details[3]} 39 | 40 | aws s3 sync s3://govuk-integration-database-backups/mongodb/daily/${SRC_HOSTNAME}/ "$BACKUPS/$DATE/mongo/$SRC_HOSTNAME/" --exclude "*" --include "${FILE_NAME}" 41 | 42 | MONGODB_FILES+=("$FILE_NAME") 43 | done 44 | 45 | # 46 | # Download PostgreSQL backups from govuk_env_sync 47 | # 48 | 49 | CONTENT_DATA_API_POSTGRESQL_DATABASES=(content_performance_manager_production) 50 | 51 | for index in "${!CONTENT_DATA_API_POSTGRESQL_DATABASES[@]}" 52 | do 53 | DATABASE="${CONTENT_DATA_API_POSTGRESQL_DATABASES[$index]}" 54 | 55 | LATEST_TIMESTAMP="$(aws s3 ls "s3://govuk-integration-database-backups/content-data-api-postgresql/" \ 56 | | grep "\\-${DATABASE}" \ 57 | | tail -1 \ 58 | | grep -o '[0-9]\{4\}-[0-9]\{2\}-[0-9]\{2\}T[0-9]\{2\}:[0-9]\{2\}:[0-9]\{2\}')" 59 | 60 | SOURCE="s3://govuk-integration-database-backups/content-data-api-postgresql/${LATEST_TIMESTAMP}-${DATABASE}.gz" 61 | DEST="$BACKUPS/$DATE/postgresql/$DATABASE.dump" 62 | echo "download: $SOURCE to $DEST" 63 | 64 | aws s3 cp "$SOURCE" "$DEST" 65 | done 66 | 67 | # 68 | # Re-compress the backups 69 | # 70 | 71 | export XZ_OPT="-9 -T0" 72 | 73 | for index in "${!MONGODB_HOSTNAMES[@]}" 74 | do 75 | SRC_HOSTNAME="${MONGODB_HOSTNAMES[$index]}" 76 | 77 | if [ -z "${MONGODB_FILES[$index]}" ]; then 78 | continue 79 | fi 80 | 81 | file="$BACKUPS/$DATE/mongo/$SRC_HOSTNAME/${MONGODB_FILES[$index]}" 82 | var_directory="$BACKUPS/$DATE/mongo/$SRC_HOSTNAME/var" 83 | 84 | if [ -d "$var_directory" ]; then 85 | echo "$var_directory already exists" 86 | else 87 | echo "unpacking $file" 88 | 89 | tar -I pigz -xf "$file" -C "$(dirname $file)" 90 | 91 | for database in $(find "$var_directory/lib/mongodb/backup/mongodump/" -type d | tail -n+2); do 92 | echo "Processing $(basename $database)" 93 | tar -cJf "$(dirname $var_directory)/$(basename $database).tar.xz" -C "$(dirname $database)" "$(basename $database)" 94 | 95 | rm -r "$database" 96 | done 97 | 98 | rmdir --ignore-fail-on-non-empty --parents "$var_directory/lib/mongodb/backup/mongodump" 99 | mkdir "$var_directory" # so that this isn't processed again 100 | fi 101 | done 102 | 103 | for file in $(find "$BACKUPS/$DATE" -name "*.dump.gz"); do 104 | echo "$file" 105 | 106 | newfile="${file/dump.gz/dump.xz}" 107 | 108 | if [ -f "$newfile" ]; then 109 | echo "$newfile already exists" 110 | else 111 | echo "creating ${newfile}..." 112 | pv "$file" | gzip -d | xz -9 -z -T0 -c > "$newfile" 113 | fi 114 | done 115 | -------------------------------------------------------------------------------- /bin/govuk: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # The govuk script provides a consistent way to run other programs 4 | # related to GOV.UK, while helping to handle differences in 5 | # environment. 6 | 7 | if [ ! -n "$BASH" ] ; then 8 | exec bash "$0" $@ 9 | fi 10 | 11 | set -e 12 | set -o pipefail 13 | 14 | function log { 15 | if [ "$GOVUK_EXEC_DEBUG" != "" ]; then 16 | echo "$1" 17 | fi 18 | } 19 | 20 | log "\$0 is $0" 21 | case "$0" in 22 | \/*) SCRIPT_PATH="$0";; 23 | *) log "\$0 does not start with / so using readlink -f"; 24 | case $(uname) in 25 | "Darwin") 26 | # readlink -f doesn't work on MacOS 27 | SCRIPT_PATH="$PWD/${0#./}";; 28 | *) 29 | SCRIPT_PATH=$(readlink -f "$0");; 30 | esac;; 31 | esac 32 | 33 | log "SCRIPT_PATH is $SCRIPT_PATH" 34 | 35 | export GOVUK_GUIX_ROOT="$(dirname $(dirname $SCRIPT_PATH))" 36 | log "Using $GOVUK_GUIX_ROOT as GOVUK_GUIX_ROOT" 37 | 38 | if [ -d "$GOVUK_GUIX_ROOT/.git" ]; then 39 | # Probably running from a Git repository, so assume the above 40 | # directory is the GOVUK_ROOT_DIR 41 | export GOVUK_ROOT_DIR="$(dirname $GOVUK_GUIX_ROOT)" 42 | else 43 | # Probably installed, maybe through Homebrew. Try to figure out 44 | # where other GOV.UK repositories are located by looking at $HOME 45 | case $(uname) in 46 | "Darwin") 47 | export GOVUK_ROOT_DIR="$HOME/govuk";; 48 | *) 49 | export GOVUK_ROOT_DIR="$(readlink -f "$HOME/govuk")";; 50 | esac 51 | fi 52 | log "Using $GOVUK_ROOT_DIR as GOVUK_ROOT_DIR" 53 | 54 | if [ "$GOVUK_EXEC_PATH" = "" ]; then 55 | GOVUK_EXEC_PATH="$GOVUK_ROOT_DIR/govuk-connect/bin:$GOVUK_ROOT_DIR/govuk-docker/bin:$(dirname "$SCRIPT_PATH")" 56 | log "GOVUK_EXEC_PATH is empty, so setting a default value" 57 | fi 58 | 59 | log "GOVUK_EXEC_PATH is $GOVUK_EXEC_PATH" 60 | log "Adding GOVUK_EXEC_PATH to PATH" 61 | 62 | PATH="$GOVUK_EXEC_PATH:$PATH" 63 | 64 | COMMAND="$1" 65 | 66 | log "COMMAND is $COMMAND" 67 | 68 | if [ "$COMMAND" = "" ]; then 69 | echo "Please specify a command, e.g. connect, data or system" 70 | exit 1 71 | fi 72 | 73 | COMMAND_FULL_NAME="govuk-$COMMAND" 74 | COMMAND_FULL_PATH=$(type -p "$COMMAND_FULL_NAME" || echo "") 75 | 76 | if [ "$COMMAND_FULL_PATH" = "" ]; then 77 | echo "Command $COMMAND not found" 78 | exit 1 79 | fi 80 | 81 | log "COMMAND_FULL_PATH is $COMMAND_FULL_PATH" 82 | 83 | # Determine if guile is available 84 | GUILE="" 85 | if [ ! -f /usr/bin/guile ]; then 86 | GUILE=$(type -pf guile || echo "") 87 | 88 | if [ "$GUILE" = "" ]; then 89 | log "guile is not on the PATH" 90 | GUILE="bash $GOVUK_GUIX_ROOT/guix-pre-inst-env guile --no-auto-compile" 91 | else 92 | GUILE="$GUILE --no-auto-compile" 93 | fi 94 | 95 | log "Using $GUILE as GUILE" 96 | else 97 | log "Using /usr/bin/guile for guile" 98 | fi 99 | 100 | RUBY="" 101 | if [ -f /usr/lib/rbenv/versions/2.5.1/bin/ruby ]; then 102 | RUBY="/usr/lib/rbenv/versions/2.5.1/bin/ruby" 103 | else 104 | RUBY="ruby" 105 | fi 106 | 107 | log # empty line in log output 108 | 109 | if [[ "$COMMAND" == "data" ]]; then 110 | GUIX=$(type -pf guile || echo "") 111 | if [ -z "$GUIX" ]; then 112 | exec $RUBY "$(type -p govuk-data-standalone)" "${@:2}" 113 | else 114 | exec $GUILE "$COMMAND_FULL_PATH" "${@:2}" 115 | fi 116 | elif [ "$COMMAND" = "data-standalone" ]; then 117 | exec $RUBY "$COMMAND_FULL_PATH" "${@:2}" 118 | elif [ "$COMMAND" = "system" ]; then 119 | exec $GUILE "$COMMAND_FULL_PATH" "${@:2}" 120 | elif [ "$COMMAND" = "refresh" ]; then 121 | exec $GUILE "$COMMAND_FULL_PATH" "${@:2}" 122 | elif [ "$COMMAND" = "cuirass-jobs" ]; then 123 | exec $GUILE "$COMMAND_FULL_PATH" "${@:2}" 124 | else 125 | exec "$COMMAND_FULL_PATH" "${@:2}" 126 | fi 127 | -------------------------------------------------------------------------------- /gds/data/tar-extract.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds data tar-extract) 2 | #:use-module (ice-9 match) 3 | #:use-module (guix gexp) 4 | #:use-module (guix store) 5 | #:use-module (guix packages) 6 | #:use-module (guix records) 7 | #:use-module (guix monads) 8 | #:use-module (gnu packages base) 9 | #:use-module (gnu packages compression) 10 | #:export ( 11 | tar-extract 12 | tar-extract? 13 | tar-extract-name 14 | tar-extract-archive 15 | tar-extract-member 16 | tar-extract-strip-components)) 17 | 18 | (define-record-type* 19 | tar-extract make-tar-extract 20 | tar-extract? 21 | (name tar-extract-name) 22 | (archive tar-extract-archive) 23 | (member tar-extract-member) 24 | (strip-components tar-extract-strip-components 25 | (default 0))) 26 | 27 | (define-gexp-compiler (tar-extract-compiler 28 | (tar-extract ) system target) 29 | (match tar-extract 30 | (($ name archive member strip-components) 31 | (mlet %store-monad ((guile (package->derivation (default-guile) system))) 32 | 33 | (define inputs (list gzip bzip2 xz)) 34 | 35 | (define build 36 | (with-imported-modules `((guix build utils)) 37 | #~(let* ((tmp-directory (tmpnam)) 38 | (tar-command 39 | (list 40 | (string-append #$tar "/bin/tar") 41 | "--extract" 42 | "--wildcards" 43 | #$@(if (> strip-components 0) 44 | (list 45 | (simple-format #f "--strip-components=~A" 46 | strip-components)) 47 | '()) 48 | "--file" #$archive 49 | (string-append "--directory=" tmp-directory) 50 | "-x" 51 | #$member))) 52 | (use-modules (srfi srfi-1) 53 | (ice-9 ftw) 54 | (guix build utils)) 55 | (set-path-environment-variable 56 | "PATH" '("bin" "sbin") '#+inputs) 57 | 58 | (simple-format #t "\nrunning ~A\n" (string-join tar-command)) 59 | (force-output) 60 | (mkdir tmp-directory) 61 | (let ((status (apply system* tar-command))) 62 | (unless (zero? status) 63 | (exit 1)) 64 | (let ((extracted-files 65 | (scandir tmp-directory 66 | (negate (lambda (f) (member f '("." ".."))))))) 67 | (simple-format #t "extracted ~A\n" extracted-files) 68 | (if (eq? 1 (length extracted-files)) 69 | (begin 70 | (let* ((file (first extracted-files)) 71 | (file-path (string-append tmp-directory "/" file))) 72 | (if (directory-exists? file-path) 73 | (copy-recursively file-path #$output) 74 | (copy-file file-path #$output)) 75 | (simple-format #t "tar-extract of ~A produced ~A\n" 76 | #$archive #$output))) 77 | (begin 78 | (display "\nMore than one file extracted:\n") 79 | (for-each (lambda (f) (simple-format #t " - ~A\n" f)) 80 | extracted-files) 81 | (error "More than one file extracted")))))))) 82 | 83 | (gexp->derivation name build 84 | #:system system 85 | #:local-build? #t 86 | #:recursive? #t 87 | #:guile-for-build guile))))) 88 | -------------------------------------------------------------------------------- /gds/scripts/govuk/data/load.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds scripts govuk data load) 2 | #:use-module (srfi srfi-1) 3 | #:use-module (srfi srfi-11) 4 | #:use-module (srfi srfi-19) 5 | #:use-module (srfi srfi-37) 6 | #:use-module (ice-9 match) 7 | #:use-module (guix gexp) 8 | #:use-module (guix store) 9 | #:use-module (guix monads) 10 | #:use-module (guix derivations) 11 | #:use-module (gnu services) 12 | #:use-module (gnu services databases) 13 | #:use-module (gds services govuk) 14 | #:use-module (gds services utils databases) 15 | #:use-module (gds services utils databases postgresql) 16 | #:use-module (gds services utils databases mysql) 17 | #:use-module (gds data govuk) 18 | #:use-module (gds data data-extract) 19 | #:use-module (gds data data-source) 20 | #:use-module (gds data transformations) 21 | #:use-module (gds data transformations postgresql) 22 | #:use-module (gds data transformations mysql) 23 | #:export (load-extracts)) 24 | 25 | (define (show-selected-extracts extracts-and-database-connection-configs) 26 | (display "Extracts selected:\n") 27 | (map 28 | (match-lambda 29 | ((data-extract . database-connection-configs) 30 | (for-each 31 | (lambda (database-connection-config) 32 | (match data-extract 33 | (($ name file datetime database 34 | services data-source) 35 | (simple-format 36 | #t " - ~A extract from ~A (~A) into the ~A database for" 37 | database 38 | (date->string datetime "~d/~m/~Y") 39 | (data-source-name data-source) 40 | (match database 41 | ("elasticsearch" "elasticsearch") 42 | (else 43 | (database-connection-config->database-name 44 | database-connection-config)))) 45 | (if (eq? 1 (length services)) 46 | (simple-format #t " the ~A service\n" 47 | (service-type-name (first services))) 48 | (begin 49 | (display ":\n") 50 | (for-each 51 | (lambda (service) 52 | (simple-format #t " - ~A\n" 53 | (service-type-name service))) 54 | services)))))) 55 | database-connection-configs))) 56 | extracts-and-database-connection-configs) 57 | (display "\n")) 58 | 59 | (define* (load-selected-extracts 60 | extracts-and-database-connection-configs 61 | #:key dry-run?) 62 | (map 63 | (match-lambda 64 | ((data-extract . database-connection-configs) 65 | (for-each 66 | (lambda (database-connection-config) 67 | (match data-extract 68 | (($ name file datetime database services) 69 | (simple-format 70 | #t "Importing extract from ~A in to ~A\n" 71 | (date->string datetime "~d/~m/~Y") 72 | (match database 73 | ("elasticsearch" "elasticsearch") 74 | (else (database-connection-config->database-name 75 | database-connection-config)))))) 76 | (display "\n") 77 | (load-extract data-extract database-connection-config 78 | #:dry-run? dry-run? 79 | #:use-local-files-directly? #t)) 80 | database-connection-configs))) 81 | extracts-and-database-connection-configs)) 82 | 83 | (define* (load-extracts services data-extracts 84 | #:key dry-run? verbose? max-jobs) 85 | (let ((extracts-and-database-connection-configs 86 | (get-extracts-and-database-connection-configs services 87 | data-extracts))) 88 | (show-selected-extracts extracts-and-database-connection-configs) 89 | (load-selected-extracts extracts-and-database-connection-configs 90 | #:dry-run? dry-run?))) 91 | -------------------------------------------------------------------------------- /gds/services/utils/databases/rabbitmq.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds services utils databases rabbitmq) 2 | #:use-module (ice-9 match) 3 | #:use-module (guix gexp) 4 | #:use-module (guix records) 5 | #:use-module (gnu packages rabbitmq) 6 | #:export ( 7 | rabbitmq-connection-config 8 | rabbitmq-connection-config? 9 | rabbitmq-connection-config-hosts 10 | rabbitmq-connection-config-vhost 11 | rabbitmq-connection-config-user 12 | rabbitmq-connection-config-password 13 | 14 | rabbitmq-create-user-for-connection-config)) 15 | 16 | (define-record-type* 17 | rabbitmq-connection-config make-rabbitmq-connection-config 18 | rabbitmq-connection-config? 19 | (hosts rabbitmq-connection-config-hosts 20 | (default '("localhost"))) 21 | (vhost rabbitmq-connection-config-vhost 22 | (default "/")) 23 | (user rabbitmq-connection-config-user) 24 | (password rabbitmq-connection-config-password)) 25 | 26 | (define rabbitmqctl 27 | (lambda args 28 | #~(let ((command (cons* 29 | (string-append #$rabbitmq "/sbin/rabbitmqctl") 30 | (list #$@args)))) 31 | ;; Set the correct value for the .erlang-cookie 32 | (copy-file "/var/lib/rabbitmq/.erlang.cookie" "/root/.erlang.cookie") 33 | 34 | (simple-format #t "Running ~A\n" (string-join command)) 35 | (let ((exit-val 36 | (status:exit-val (apply system* command)))) 37 | (if (zero? exit-val) 38 | #t 39 | (begin 40 | (simple-format #t "Command failed (~A)\n" exit-val) 41 | #f)))))) 42 | 43 | (define rabbitmqctl-list-users 44 | #~(lambda () 45 | ;; Set the correct value for the .erlang-cookie 46 | (copy-file "/var/lib/rabbitmq/.erlang.cookie" "/root/.erlang.cookie") 47 | 48 | ;; Set LC_ALL, as Elixir needs a UTF-8 locale 49 | (setenv "LC_ALL" "en_US.UTF-8") ; Use en_US, as this is in the 50 | ; glibc-utf8-locales package 51 | (system* #$(file-append rabbitmq "/sbin/rabbitmqctl") 52 | "wait" "/var/run/rabbitmq/pid") 53 | (let* ((command `(,(string-append #$rabbitmq "/sbin/rabbitmqctl") 54 | "list_users" "-s")) 55 | (p (apply open-pipe* OPEN_READ command)) 56 | (lines (let loop ((lines '()) 57 | (line (read-line p))) 58 | (if (eof-object? line) 59 | (reverse lines) 60 | (loop (cons line lines) 61 | (read-line p)))))) 62 | (and (let ((status (status:exit-val (close-pipe p)))) 63 | (if (zero? status) 64 | #t 65 | (begin 66 | (simple-format #t 67 | "command: ~A\n" 68 | (string-join command)) 69 | (error "listing users failed, status ~A" status)))) 70 | (map (lambda (line) 71 | (let ((m (string-match "^(\\S+)\\s+\\[(.*?)\\]$" line))) 72 | (cons (match:substring m 1) 73 | (string-split (match:substring m 2) 74 | #\,)))) 75 | lines))))) 76 | 77 | (define (rabbitmq-create-user-for-connection-config connection-config) 78 | (match connection-config 79 | (($ hosts vhost user password) 80 | #~(lambda () 81 | (use-modules (ice-9 popen) 82 | (ice-9 rdelim) 83 | (ice-9 regex)) 84 | 85 | (let* ((users (#$rabbitmqctl-list-users))) 86 | (simple-format #t "users ~A\n\n" users) 87 | 88 | (and (if (member #$user (map car users)) 89 | (begin 90 | (simple-format #t "RabbitMQ user ~A already exists\n" #$user) 91 | #t) 92 | #$(rabbitmqctl "add_user" user password)) 93 | #$(rabbitmqctl "set_permissions" user ".*" ".*" ".*"))))))) 94 | -------------------------------------------------------------------------------- /gds/data/s3.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds data s3) 2 | #:use-module (srfi srfi-1) 3 | #:use-module (ice-9 popen) 4 | #:use-module (ice-9 rdelim) 5 | #:use-module (json) 6 | #:use-module (guix gexp) 7 | #:use-module (guix monads) 8 | #:use-module (guix memoization) 9 | #:use-module (guix store) 10 | #:use-module (guix packages) 11 | #:use-module (gnu packages python-web) 12 | #:export (s3-fetch-for-profile 13 | s3-fetch-with-access-key 14 | s3-fetch-with-access-key-or-profile)) 15 | 16 | (define (s3-fetch-for-profile-internal profile) 17 | (define environment-variables 18 | (let* ((json-data 19 | (read-line 20 | (open-pipe* OPEN_READ 21 | "govuk" "aws" "--profile" profile 22 | "--export-json")))) 23 | (hash-map->list 24 | (lambda (key value) 25 | (if (member key '("access_key_id" "secret_access_key" "session_token")) 26 | (cons (string-append "AWS_" (string-upcase key)) 27 | value) 28 | (error "Unknown key " key))) 29 | (json-string->scm json-data)))) 30 | 31 | (lambda* (uri 32 | hash-algo hash 33 | #:optional name 34 | #:key (system (%current-system)) (guile (default-guile))) 35 | 36 | (define build 37 | (with-imported-modules '((guix build utils)) 38 | #~(begin 39 | (use-modules (guix build utils)) 40 | (invoke #$(file-append awscli "/bin/aws") 41 | "s3" "cp" (getenv "s3 uri") #$output)))) 42 | 43 | (mlet %store-monad ((guile (package->derivation guile system))) 44 | (gexp->derivation (or name "s3-fetch") 45 | build 46 | ;; Use environment variables and a fixed script name so 47 | ;; there's only one script in store for all the 48 | ;; downloads. 49 | #:script-name "s3-fetch" 50 | #:env-vars 51 | `(("s3 uri" . ,uri) 52 | ,@environment-variables) 53 | #:system system 54 | #:local-build? #t 55 | #:hash-algo hash-algo 56 | #:hash hash 57 | #:recursive? #f 58 | #:guile-for-build guile)))) 59 | 60 | (define s3-fetch-for-profile (memoize s3-fetch-for-profile-internal)) 61 | 62 | (define (s3-fetch-with-access-key access-key-id secret-access-key) 63 | (lambda* (uri 64 | hash-algo hash 65 | #:optional name 66 | #:key (system (%current-system)) (guile (default-guile))) 67 | 68 | (define build 69 | (with-imported-modules '((guix build utils)) 70 | #~(begin 71 | (use-modules (guix build utils)) 72 | (invoke #$(file-append awscli "/bin/aws") 73 | "s3" "cp" (getenv "s3 uri") #$output)))) 74 | 75 | (mlet %store-monad ((guile (package->derivation guile system))) 76 | (gexp->derivation (or name "s3-fetch") 77 | build 78 | ;; Use environment variables and a fixed script name so 79 | ;; there's only one script in store for all the 80 | ;; downloads. 81 | #:script-name "s3-fetch" 82 | #:env-vars 83 | `(("s3 uri" . ,uri) 84 | ("AWS_ACCESS_KEY_ID" . ,access-key-id) 85 | ("AWS_SECRET_ACCESS_KEY" . ,secret-access-key)) 86 | #:system system 87 | #:local-build? #t 88 | #:hash-algo hash-algo 89 | #:hash hash 90 | #:recursive? #f 91 | #:guile-for-build guile)))) 92 | 93 | (define (s3-fetch-with-access-key-or-profile profile) 94 | (let ((access-key-id (getenv "AWS_ACCESS_KEY_ID")) 95 | (secret-access-key (getenv "AWS_SECRET_ACCESS_KEY"))) 96 | (if (and access-key-id secret-access-key) 97 | (s3-fetch-with-access-key access-key-id 98 | secret-access-key) 99 | (s3-fetch-for-profile profile)))) 100 | -------------------------------------------------------------------------------- /gds/systems/govuk/aws.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds systems govuk aws) 2 | #:use-module (guix gexp) 3 | #:use-module (guix packages) 4 | #:use-module (guix build-system trivial) 5 | #:use-module (gnu) 6 | #:use-module (gnu packages guile) 7 | #:use-module (gnu services shepherd) 8 | #:use-module (gnu services ssh) 9 | #:use-module (gds systems govuk production) 10 | #:export (aws-pubkey-service-type 11 | govuk-aws-os)) 12 | 13 | (define aws-fetch-ssh-key-script 14 | (plain-file 15 | "aws-fetch-ssh-key" 16 | "#!/usr/bin/guile 17 | !# 18 | 19 | (use-modules 20 | (ice-9 receive) 21 | (web client) 22 | (ice-9 binary-ports)) 23 | 24 | (define (meta-data path) 25 | (let ((uri (string-append \"http://169.254.169.254/latest/\" path))) 26 | (receive (header body) 27 | (http-get uri #:decode-body? #f) 28 | body))) 29 | 30 | (let* ((pubkey (meta-data \"meta-data/public-keys/0/openssh-key\"))) 31 | (call-with-output-file \"/etc/ssh/authorized_keys.d/govuk\" 32 | (lambda (port) 33 | (put-bytevector port pubkey))))")) 34 | 35 | (define-public aws-fetch-ssh-key 36 | (package 37 | (name "aws-fetch-ssh-key") 38 | (version "0.1") 39 | (source aws-fetch-ssh-key-script) 40 | (build-system trivial-build-system) 41 | (arguments 42 | '(#:modules ((guix build utils)) 43 | #:builder 44 | (begin 45 | (use-modules (guix build utils)) 46 | (let* ((bin-dir (string-append %output "/bin")) 47 | (bin-file (string-append bin-dir "/aws-fetch-ssh-key")) 48 | (guile-bin (string-append (assoc-ref %build-inputs "guile") 49 | "/bin"))) 50 | (mkdir-p bin-dir) 51 | (copy-file (assoc-ref %build-inputs "source") bin-file) 52 | (patch-shebang bin-file (list guile-bin)) 53 | (chmod bin-file #o555))))) 54 | (inputs `(("guile" ,guile-2.2))) 55 | (home-page #f) 56 | (synopsis "A simple AWS EC2 ssh key fetcher") 57 | (description "fetch-ssh-key.scm is a simple tool that fetches the 58 | ssh public key from instance metadata, assuming you're running on 59 | AWS EC2.") 60 | (license #f))) 61 | 62 | (define aws-pubkey-service-type 63 | (shepherd-service-type 64 | 'aws-pubkey 65 | (lambda (package) 66 | (shepherd-service 67 | (documentation "Initialize admin user public key.") 68 | (requirement '(networking)) 69 | (provision '(aws-pubkey)) 70 | (one-shot? #t) 71 | (start 72 | #~(lambda _ 73 | (system* #$(file-append package "/bin/aws-fetch-ssh-key")))) 74 | (respawn? #f))) 75 | aws-fetch-ssh-key)) 76 | 77 | (define govuk-aws-os 78 | (operating-system 79 | (inherit govuk-production-os) 80 | 81 | (bootloader (bootloader-configuration 82 | (bootloader grub-bootloader) 83 | (target "/dev/xvdf"))) 84 | 85 | (kernel-arguments 86 | '("quiet" 87 | ;; The following argument makes the "System Log" work on the AWS 88 | ;; website 89 | "console=ttyS0")) 90 | 91 | (file-systems (cons (file-system 92 | (device (file-system-label "my-root")) 93 | (mount-point "/") 94 | (type "ext4")) 95 | %base-file-systems)) 96 | 97 | (users (cons (user-account 98 | (name "govuk") 99 | (comment "Admin user") 100 | (group "users") 101 | 102 | ;; Adding the account to the "wheel" group 103 | ;; makes it a sudoer. 104 | (supplementary-groups '("wheel")) 105 | (home-directory "/home/govuk")) 106 | %base-user-accounts)) 107 | 108 | (sudoers-file (plain-file 109 | "sudoers" 110 | (string-append 111 | "root ALL=(ALL) ALL\n" 112 | "%wheel ALL=(ALL) NOPASSWD:ALL\n"))) 113 | 114 | (services (cons* (service aws-pubkey-service-type) 115 | (service openssh-service-type 116 | (openssh-configuration 117 | (password-authentication? #f))) 118 | (operating-system-user-services govuk-production-os))))) 119 | -------------------------------------------------------------------------------- /gds/data/transformations/build/postgresql.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds data transformations build postgresql) 2 | #:use-module (srfi srfi-1) 3 | #:use-module (ice-9 popen) 4 | #:use-module (ice-9 match) 5 | #:use-module (ice-9 ftw) 6 | #:export (tar-extract 7 | 8 | pg-restore 9 | pg-dump 10 | decompress-file-and-pipe-to-psql 11 | run-with-psql-port 12 | pg-dump-parallel-compression)) 13 | 14 | (define (parallel-job-count) 15 | (match (getenv "NIX_BUILD_CORES") 16 | (#f 1) 17 | ("0" (current-processor-count)) 18 | (x (or (string->number x) 1)))) 19 | 20 | (define* (tar-extract tar file target) 21 | (define decompressor 22 | (assoc-ref '(("gz" . "gzip") 23 | ("xz" . "xz")) 24 | (last (string-split file #\.)))) 25 | 26 | (let ((command 27 | (string-join 28 | `("set -eo pipefail;" 29 | "pv" "--force" ,file "|" 30 | ,@(if decompressor 31 | `(,decompressor "-d" "|") 32 | '()) 33 | ,tar "--extract" "--directory" ,target) 34 | " "))) 35 | (simple-format #t "tar-extract running:\n ~A\n" 36 | command) 37 | (force-output) 38 | (or (zero? (system command)) 39 | (error "tar-extract failed")))) 40 | 41 | (define (pg-restore file database) 42 | (let ((command 43 | `("pg_restore" 44 | ,(string-append "--dbname=" database) 45 | ,(simple-format #f "--jobs=~A" (parallel-job-count)) 46 | "--exit-on-error" 47 | ,file))) 48 | (simple-format #t "pg-restore running:\n ~A\n" 49 | (string-join command " ")) 50 | (force-output) 51 | (or 52 | (zero? (apply system* command)) 53 | (error "pg_restore failed")))) 54 | 55 | (define* (pg-dump database-name output-path 56 | #:key format) 57 | (let ((command 58 | `("pg_dump" 59 | ,database-name 60 | ,(string-append "--file=" output-path) 61 | "--verbose" 62 | ,@(if (string=? format "directory") 63 | '("--jobs=8") 64 | '()) 65 | ,@(if format 66 | `(,(simple-format #f "--format=~A" format)) 67 | '())))) 68 | (simple-format #t "running:\n ~A\n" 69 | (string-join command " ")) 70 | (force-output) 71 | (or 72 | (zero? (apply system* command)) 73 | (error "pg_dump failed")))) 74 | 75 | (define (pg-dump-parallel-compression database-name output-path) 76 | (let ((command 77 | `("pg_dump" 78 | ,database-name 79 | ,(string-append "--file=" output-path) 80 | "--verbose" 81 | "--jobs=8" 82 | "--compress=0" 83 | "--format=directory"))) 84 | (simple-format #t "running:\n ~A\n" 85 | (string-join command " ")) 86 | (force-output) 87 | (or 88 | (zero? (apply system* command)) 89 | (error "pg_dump failed"))) 90 | 91 | (for-each 92 | (lambda (file) 93 | (or (zero? (system* "pigz" "-9" "--verbose" 94 | (string-append output-path "/" file))) 95 | (error "pigz failed"))) 96 | (scandir output-path 97 | (lambda (name) 98 | (and (not (string-prefix? "toc" name)) 99 | (not (string-prefix? "." name))))))) 100 | 101 | (define (run-with-psql-port database-name user operations) 102 | (let ((p (open-pipe* 103 | OPEN_WRITE "psql" 104 | (string-append "--user=" user) 105 | "-a" 106 | "--no-psqlrc" 107 | database-name))) 108 | (for-each 109 | (lambda (o) (o p)) 110 | (if (list? operations) 111 | operations 112 | (list operations))) 113 | (close-pipe p))) 114 | 115 | (define* (decompress-file-and-pipe-to-psql file database) 116 | (define decompressor 117 | (assoc-ref '(("gz" . "gzip") 118 | ("xz" . "xz")) 119 | (last (string-split file #\.)))) 120 | 121 | (let ((command 122 | (string-join 123 | `("set -eo pipefail;" 124 | "pv" "--force" ,file "|" 125 | ,@(if decompressor 126 | `(,decompressor "-d" "|") 127 | '()) 128 | "psql" "--no-psqlrc" "--quiet" ,database) 129 | " "))) 130 | (simple-format #t "ungzip-file-and-pipe-to-psql running:\n ~A\n" 131 | command) 132 | (force-output) 133 | (setenv "XZ_OPT" "-T0") 134 | (or (zero? (system command)) 135 | (error "ungzip-file-and-pipe-to-psql failed")))) 136 | -------------------------------------------------------------------------------- /gds/packages/utils/bundler-build.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds packages utils bundler-build) 2 | #:use-module (ice-9 match) 3 | #:use-module (guix build utils) 4 | #:export (run-bundle-package)) 5 | 6 | (define (run-bundle-package source 7 | output-path 8 | working-directory 9 | input-store-paths 10 | ca-certificates-path 11 | nss-certs-path 12 | search-paths 13 | bundle-without 14 | ruby-version) 15 | (define (run . args) 16 | (simple-format #t "running ~A\n" (string-join args)) 17 | (force-output) 18 | (zero? (apply system* args))) 19 | 20 | (set-path-environment-variable "PATH" '("bin" "sbin") 21 | input-store-paths) 22 | 23 | (for-each (match-lambda 24 | ((env-var (files ...) separator type pattern) 25 | (set-path-environment-variable 26 | env-var files 27 | (cons* 28 | ca-certificates-path 29 | input-store-paths) 30 | #:separator separator 31 | #:type type 32 | #:pattern pattern))) 33 | search-paths) 34 | 35 | (if (null? bundle-without) 36 | (unsetenv "BUNDLE_WITHOUT") 37 | (setenv "BUNDLE_WITHOUT" (string-join bundle-without ":"))) 38 | 39 | (let* ((home (string-append working-directory "/HOME")) 40 | (vendor/cache (string-append output-path "/vendor/cache"))) 41 | 42 | (mkdir-p vendor/cache) 43 | 44 | (mkdir-p home) 45 | (setenv "HOME" home) 46 | (setenv "GEM_HOME" home) 47 | 48 | (setenv "SSL_CERT_DIR" (string-append 49 | nss-certs-path "/etc/ssl/certs")) 50 | (setenv "SSL_CERT_FILE" (string-append 51 | ca-certificates-path 52 | "/etc/ssl/certs/ca-certificates.crt")) 53 | 54 | (if (directory-exists? source) 55 | (for-each 56 | (lambda (file) 57 | (let ((from (string-append source "/" file)) 58 | (to (string-append output-path "/" file))) 59 | (simple-format #t "Copying ~A from ~A to ~A\n" file from to) 60 | (copy-file from to))) 61 | '("Gemfile" "Gemfile.lock")) 62 | (run "tar" 63 | "--extract" 64 | "--anchored" 65 | "--wildcards" 66 | "--no-wildcards-match-slash" 67 | "--strip-components=1" 68 | "-C" output-path 69 | "-x" 70 | "-f" source 71 | "*/Gemfile*")) 72 | (simple-format #t "Using Gemfile ~A\n" (string-append 73 | output-path 74 | "/Gemfile\n")) 75 | (simple-format #t "Using Gemfile.lock ~A\n" (string-append 76 | output-path 77 | "/Gemfile.lock\n")) 78 | 79 | (simple-format #t "Setting .ruby-version to ~A\n" ruby-version) 80 | (call-with-output-file (string-append output-path "/.ruby-version") 81 | (lambda (port) 82 | (simple-format port "~A\n" ruby-version))) 83 | 84 | 85 | (with-directory-excursion output-path 86 | (chmod "Gemfile.lock" #o644) 87 | (run "bundle" 88 | "config" 89 | "build.nokogiri" 90 | "--use-system-libraries") 91 | (let loop ((retry 0)) 92 | (unless (run "bundle" 93 | "package" 94 | "--all" 95 | "--no-install") 96 | (if (> retry 3) 97 | (exit 1) 98 | (loop (+ retry 1))))) 99 | (substitute* "Gemfile.lock" 100 | (("RUBY VERSION.*") "XXX") 101 | (("BUNDLED WITH.*") "XXX")) 102 | (substitute* "Gemfile.lock" 103 | (("XXX.*") ""))) 104 | 105 | (simple-format #t "Deleting .ruby-version\n") 106 | (delete-file (string-append output-path "/.ruby-version")) 107 | (let ((files (find-files output-path".*\\.gemspec"))) 108 | (if (null? files) 109 | (simple-format #t "No gemspecs to substitute dates for\n") 110 | (begin 111 | (simple-format #t "Substituting dates in ~A\n" 112 | (string-join files ", ")) 113 | (substitute* files 114 | ((".*s\\.date = \".*\"") 115 | " # date removed by govuk-guix") 116 | ((".*s\\.rubygems\\_version = .*$") 117 | " # rubygems_version removed by govuk-guix\n"))))))) 118 | -------------------------------------------------------------------------------- /.dir-locals.el: -------------------------------------------------------------------------------- 1 | ;; Per-directory local variables for GNU Emacs 23 and later. 2 | 3 | ((nil 4 | . ((fill-column . 78) 5 | (tab-width . 8))) 6 | (scheme-mode 7 | . 8 | ((indent-tabs-mode . nil) 9 | (eval . (put 'eval-when 'scheme-indent-function 1)) 10 | (eval . (put 'call-with-prompt 'scheme-indent-function 1)) 11 | (eval . (put 'test-assert 'scheme-indent-function 1)) 12 | (eval . (put 'test-assertm 'scheme-indent-function 1)) 13 | (eval . (put 'test-equalm 'scheme-indent-function 1)) 14 | (eval . (put 'test-equal 'scheme-indent-function 1)) 15 | (eval . (put 'test-eq 'scheme-indent-function 1)) 16 | (eval . (put 'call-with-input-string 'scheme-indent-function 1)) 17 | (eval . (put 'guard 'scheme-indent-function 1)) 18 | (eval . (put 'lambda* 'scheme-indent-function 1)) 19 | (eval . (put 'substitute* 'scheme-indent-function 1)) 20 | (eval . (put 'match-record 'scheme-indent-function 2)) 21 | 22 | ;; 'modify-phases' and its keywords. 23 | (eval . (put 'modify-phases 'scheme-indent-function 1)) 24 | (eval . (put 'replace 'scheme-indent-function 1)) 25 | (eval . (put 'add-before 'scheme-indent-function 2)) 26 | (eval . (put 'add-after 'scheme-indent-function 2)) 27 | 28 | (eval . (put 'modify-services 'scheme-indent-function 1)) 29 | (eval . (put 'with-directory-excursion 'scheme-indent-function 1)) 30 | (eval . (put 'with-file-lock 'scheme-indent-function 1)) 31 | (eval . (put 'with-file-lock/no-wait 'scheme-indent-function 1)) 32 | (eval . (put 'with-profile-lock 'scheme-indent-function 1)) 33 | 34 | (eval . (put 'package 'scheme-indent-function 0)) 35 | (eval . (put 'origin 'scheme-indent-function 0)) 36 | (eval . (put 'build-system 'scheme-indent-function 0)) 37 | (eval . (put 'bag 'scheme-indent-function 0)) 38 | (eval . (put 'graft 'scheme-indent-function 0)) 39 | (eval . (put 'operating-system 'scheme-indent-function 0)) 40 | (eval . (put 'file-system 'scheme-indent-function 0)) 41 | (eval . (put 'manifest-entry 'scheme-indent-function 0)) 42 | (eval . (put 'manifest-pattern 'scheme-indent-function 0)) 43 | (eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1)) 44 | (eval . (put 'with-store 'scheme-indent-function 1)) 45 | (eval . (put 'with-external-store 'scheme-indent-function 1)) 46 | (eval . (put 'with-error-handling 'scheme-indent-function 0)) 47 | (eval . (put 'with-mutex 'scheme-indent-function 1)) 48 | (eval . (put 'with-atomic-file-output 'scheme-indent-function 1)) 49 | (eval . (put 'call-with-compressed-output-port 'scheme-indent-function 2)) 50 | (eval . (put 'call-with-decompressed-port 'scheme-indent-function 2)) 51 | (eval . (put 'call-with-gzip-input-port 'scheme-indent-function 1)) 52 | (eval . (put 'call-with-gzip-output-port 'scheme-indent-function 1)) 53 | (eval . (put 'call-with-lzip-input-port 'scheme-indent-function 1)) 54 | (eval . (put 'call-with-lzip-output-port 'scheme-indent-function 1)) 55 | (eval . (put 'signature-case 'scheme-indent-function 1)) 56 | (eval . (put 'emacs-batch-eval 'scheme-indent-function 0)) 57 | (eval . (put 'emacs-batch-edit-file 'scheme-indent-function 1)) 58 | (eval . (put 'emacs-substitute-sexps 'scheme-indent-function 1)) 59 | (eval . (put 'emacs-substitute-variables 'scheme-indent-function 1)) 60 | (eval . (put 'with-derivation-narinfo 'scheme-indent-function 1)) 61 | (eval . (put 'with-derivation-substitute 'scheme-indent-function 2)) 62 | (eval . (put 'with-status-report 'scheme-indent-function 1)) 63 | (eval . (put 'with-status-verbosity 'scheme-indent-function 1)) 64 | (eval . (put 'with-build-handler 'scheme-indent-function 1)) 65 | 66 | (eval . (put 'mlambda 'scheme-indent-function 1)) 67 | (eval . (put 'mlambdaq 'scheme-indent-function 1)) 68 | (eval . (put 'syntax-parameterize 'scheme-indent-function 1)) 69 | (eval . (put 'with-monad 'scheme-indent-function 1)) 70 | (eval . (put 'mbegin 'scheme-indent-function 1)) 71 | (eval . (put 'mwhen 'scheme-indent-function 1)) 72 | (eval . (put 'munless 'scheme-indent-function 1)) 73 | (eval . (put 'mlet* 'scheme-indent-function 2)) 74 | (eval . (put 'mlet 'scheme-indent-function 2)) 75 | (eval . (put 'run-with-store 'scheme-indent-function 1)) 76 | (eval . (put 'run-with-state 'scheme-indent-function 1)) 77 | (eval . (put 'wrap-program 'scheme-indent-function 1)) 78 | (eval . (put 'with-imported-modules 'scheme-indent-function 1)) 79 | (eval . (put 'with-extensions 'scheme-indent-function 1)) 80 | (eval . (put 'with-parameters 'scheme-indent-function 1)) 81 | 82 | (eval . (put 'with-database 'scheme-indent-function 2)) 83 | (eval . (put 'call-with-transaction 'scheme-indent-function 2)) 84 | 85 | (eval . (put 'call-with-container 'scheme-indent-function 1)) 86 | (eval . (put 'container-excursion 'scheme-indent-function 1)) 87 | (eval . (put 'eventually 'scheme-indent-function 1)) 88 | 89 | (eval . (put 'call-with-progress-reporter 'scheme-indent-function 1)) 90 | (eval . (put 'with-temporary-git-repository 'scheme-indent-function 2)) 91 | 92 | ;; This notably allows '(' in Paredit to not insert a space when the 93 | ;; preceding symbol is one of these. 94 | (eval . (modify-syntax-entry ?~ "'")) 95 | (eval . (modify-syntax-entry ?$ "'")) 96 | (eval . (modify-syntax-entry ?+ "'"))))) 97 | -------------------------------------------------------------------------------- /gds/systems/utils.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds systems utils) 2 | #:use-module (srfi srfi-1) 3 | #:use-module (ice-9 match) 4 | #:use-module (gnu services) 5 | #:use-module (gnu services shepherd) 6 | #:use-module (gnu system) 7 | #:use-module (gds services utils) 8 | #:export (system-without-unnecessary-services 9 | update-system-services-package-source 10 | 11 | shepherd-services-from-service 12 | find-missing-requirements 13 | find-missing-extension-targets 14 | add-missing-requirements)) 15 | 16 | (define (shepherd-services-from-service service) 17 | (let ((shepherd-root-service-type-extension 18 | (find (lambda (service-extension) 19 | (eq? (service-extension-target 20 | service-extension) 21 | shepherd-root-service-type)) 22 | (service-type-extensions (service-kind service))))) 23 | (if shepherd-root-service-type-extension 24 | ((service-extension-compute shepherd-root-service-type-extension) 25 | (service-parameters service)) 26 | '()))) 27 | 28 | (define (get-requirement->service-alist services) 29 | (concatenate 30 | (map 31 | (lambda (service) 32 | (concatenate 33 | (map 34 | (lambda (shepherd-service) 35 | (map (lambda (provisioned-name) 36 | (cons provisioned-name service)) 37 | (shepherd-service-provision shepherd-service))) 38 | (shepherd-services-from-service service)))) 39 | services))) 40 | 41 | (define (service->name service) 42 | (service-type-name (service-kind service))) 43 | 44 | (define (service-names services) 45 | (map service->name services)) 46 | 47 | (define (find-missing-requirements 48 | services requirement->service-alist) 49 | (define (services-for-requirements service) 50 | (filter-map 51 | (lambda (requirement) 52 | (assq-ref requirement->service-alist requirement)) 53 | (append-map 54 | shepherd-service-requirement 55 | (shepherd-services-from-service service)))) 56 | 57 | (fold 58 | (lambda (service missing-requirements) 59 | (append 60 | (fold 61 | (lambda (service new-services) 62 | (if (or (member service services) 63 | (member service missing-requirements) 64 | (member service new-services)) 65 | new-services 66 | (cons 67 | service 68 | new-services))) 69 | '() 70 | (services-for-requirements service)) 71 | missing-requirements)) 72 | '() 73 | services)) 74 | 75 | (define (find-missing-extension-targets services all-services) 76 | (let* ((service-types (map service-kind services)) 77 | (extensions 78 | (append-map service-type-extensions service-types)) 79 | (missing-service-types 80 | (lset-difference 81 | eq? 82 | (delete-duplicates 83 | (map service-extension-target extensions)) 84 | service-types))) 85 | (filter 86 | (lambda (service) 87 | (member (service-kind service) 88 | missing-service-types)) 89 | all-services))) 90 | 91 | (define (add-missing-requirements 92 | services all-services requirement->service) 93 | (unless (eq? (length services) 94 | (length (delete-duplicates services))) 95 | (simple-format #t "\n~A\n\n" (service-names services)) 96 | (simple-format #t "\n~A\n\n" (service-names (delete-duplicates services))) 97 | (error "duplicates")) 98 | (let 99 | ((missing-requirements 100 | (lset-union 101 | equal? 102 | (find-missing-requirements services requirement->service) 103 | (find-missing-extension-targets services all-services)))) 104 | (if (null? missing-requirements) 105 | services 106 | (add-missing-requirements 107 | (append services 108 | missing-requirements) 109 | all-services 110 | requirement->service)))) 111 | 112 | (define (system-without-unnecessary-services 113 | services-to-keep 114 | system) 115 | (for-each 116 | (lambda (service) 117 | (unless (service? service) 118 | (simple-format #t "error: system-without-unnecessary-services: not a service ~A\n" service))) 119 | services-to-keep) 120 | (for-each (lambda (service) 121 | (unless (member service 122 | (operating-system-user-services system)) 123 | (error "Could not find ~A in system services" 124 | service))) 125 | services-to-keep) 126 | (operating-system 127 | (inherit system) 128 | (services 129 | (add-missing-requirements 130 | services-to-keep 131 | (operating-system-user-services system) 132 | (get-requirement->service-alist 133 | (operating-system-user-services system)))))) 134 | 135 | (define* (update-system-services-package-source 136 | service-revisions 137 | system) 138 | (operating-system 139 | (inherit system) 140 | (services 141 | (correct-services-package-source 142 | service-revisions 143 | (operating-system-user-services system))))) 144 | -------------------------------------------------------------------------------- /gds/services/utils/databases/mongodb.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds services utils databases mongodb) 2 | #:use-module (ice-9 match) 3 | #:use-module (guix gexp) 4 | #:use-module (guix records) 5 | #:use-module (gnu packages databases) 6 | #:use-module (gnu packages compression) 7 | #:use-module (gnu packages pv) 8 | #:export ( 9 | mongodb-connection-config 10 | mongodb-connection-config? 11 | mongodb-connection-config-port 12 | mongodb-connection-config-database 13 | 14 | mongodb-restore-gexp 15 | run-with-mongodb-port 16 | mongodb-create-user-for-database-connection)) 17 | 18 | (define-record-type* 19 | mongodb-connection-config make-mongodb-connection-config 20 | mongodb-connection-config? 21 | (user mongodb-connection-config-user 22 | (default #f)) 23 | (password mongodb-connection-config-password 24 | (default #f)) 25 | (host mongodb-connection-config-host 26 | (default "127.0.0.1")) 27 | (port mongodb-connection-config-port 28 | (default 27017)) 29 | (database mongodb-connection-config-database)) 30 | 31 | (define mongodb-create-user-for-database-connection 32 | (match-lambda 33 | (($ user password host port database) 34 | #~(lambda (port) 35 | (simple-format p " 36 | var database = \"~A\"; 37 | var username = \"~A\"; 38 | 39 | db = db.getSiblingDB(database); 40 | 41 | var profile = { 42 | pwd: \"~A\", 43 | roles: [ 44 | { role: \"readWrite\", db: database } 45 | ] 46 | }; 47 | 48 | if (db.getUser(username) === null) { 49 | db.createUser( 50 | Object.assign( 51 | { 52 | user: username, 53 | }, 54 | profile 55 | ) 56 | ); 57 | } else { 58 | db.updateUser( 59 | username, 60 | profile 61 | ); 62 | } 63 | " #$database #$user #$password))))) 64 | 65 | (define (run-with-mongodb-port database-connection operations) 66 | (match database-connection 67 | (($ user password host port database) 68 | #~(lambda () 69 | (let 70 | ((mongo (string-append #$mongodb "/bin/mongo"))) 71 | (let ((p (open-pipe* OPEN_WRITE mongo "--port" (number->string #$port)))) 72 | (for-each 73 | (lambda (o) (o p)) 74 | (list #$@operations)) 75 | (simple-format p "exit") 76 | (zero? 77 | (status:exit-val 78 | (close-pipe p))))))))) 79 | 80 | (define* (mongodb-restore-gexp database-connection file 81 | #:key dry-run?) 82 | (match database-connection 83 | (($ user password host port database) 84 | #~(lambda () 85 | (use-modules (srfi srfi-1)) 86 | (if (string-suffix? ".mongo.xz" #$file) 87 | (let* ((pv (string-append #$pv "/bin/pv")) 88 | (decompressor 89 | (assoc-ref '(("gz" . #$(file-append gzip "/bin/gzip")) 90 | ("xz" . #$(file-append xz "/bin/xz"))) 91 | (last (string-split #$file #\.)))) 92 | (command 93 | (string-join 94 | `(,pv 95 | ,#$file 96 | "|" 97 | ,decompressor 98 | "-d" 99 | "|" 100 | ,(string-append #$mongo-tools "/bin/mongorestore") 101 | "--quiet" 102 | "--host" ,(simple-format #f "~A:~A" 103 | #$host 104 | (number->string #$port)) 105 | #$@(if user `("-u" #$user) '()) 106 | #$@(if password `("-p" #$password) '()) 107 | "-d" #$database 108 | "--drop" ;; TODO: Make this optional 109 | "--archive" 110 | " ")))) 111 | #$@(if dry-run? 112 | '((simple-format #t "Would run command: ~A\n" 113 | command)) 114 | '((simple-format #t "Running command: ~A\n" command) 115 | (zero? (system command))))) 116 | (let ((command 117 | `(,(string-append #$mongo-tools "/bin/mongorestore") 118 | "--host" ,(simple-format #f "~A:~A" 119 | #$host 120 | (number->string #$port)) 121 | #$@(if user `("-u" #$user) '()) 122 | #$@(if password `("-p" #$password) '()) 123 | "-d" #$database 124 | "--drop" ;; TODO: Make this optional 125 | #$file))) 126 | #$@(if dry-run? 127 | '((simple-format 128 | #t "Would run command: ~A\n" 129 | (string-join command " "))) 130 | '((simple-format #t "Running command: ~A\n" (string-join command " ")) 131 | (zero? 132 | (apply system* command)))))))))) 133 | -------------------------------------------------------------------------------- /gds/build-system/rails.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds build-system rails) 2 | #:use-module (guix store) 3 | #:use-module (guix utils) 4 | #:use-module (guix packages) 5 | #:use-module (guix download) 6 | #:use-module (guix derivations) 7 | #:use-module (guix search-paths) 8 | #:use-module (guix build-system) 9 | #:use-module (guix build-system gnu) 10 | #:use-module (ice-9 match) 11 | #:use-module (srfi srfi-26) 12 | #:use-module (gnu packages node) 13 | #:export (%rails-build-system-modules 14 | rails-build 15 | rails-build-system 16 | 17 | default-ruby)) 18 | 19 | (define %rails-build-system-modules 20 | ;; Build side modules imported by default 21 | `((guix build syscalls) 22 | ,@%gnu-build-system-modules 23 | (guix build ruby-build-system) 24 | (gds build rails-build-system))) 25 | 26 | (define (default-ruby) 27 | (let ((ruby-mod (resolve-interface '(gnu packages ruby)))) 28 | (package 29 | (inherit (module-ref ruby-mod 'ruby)) 30 | (version "2.6.5") 31 | (source 32 | (origin 33 | (method url-fetch) 34 | (uri (string-append "http://cache.ruby-lang.org/pub/ruby/" 35 | (version-major+minor version) 36 | "/ruby-" version ".tar.xz")) 37 | (sha256 38 | (base32 39 | "0qhsw2mr04f3lqinkh557msr35pb5rdaqy4vdxcj91flgxqxmmnm"))))))) 40 | 41 | (define* (lower name 42 | #:key source inputs native-inputs outputs system target 43 | (ruby (default-ruby)) 44 | #:allow-other-keys 45 | #:rest arguments) 46 | "Return a bag for NAME." 47 | (define private-keywords 48 | '(#:source #:target #:ruby #:inputs #:native-inputs)) 49 | 50 | (and (not target) ;XXX: no cross-compilation 51 | (bag 52 | (name name) 53 | (system system) 54 | (host-inputs `(,@(if source 55 | `(("source" ,source)) 56 | '()) 57 | ,@inputs 58 | ("ruby" ,ruby) 59 | ("node" ,node) ;; Rails seems to have a 60 | ;; transtive dependency on 61 | ;; node, or some Javascript 62 | ;; interpreter 63 | 64 | ;; Keep the standard inputs of 'gnu-build-system'. 65 | ,@(standard-packages))) 66 | (build-inputs native-inputs) 67 | (outputs outputs) 68 | (build rails-build) 69 | (arguments (strip-keyword-arguments private-keywords arguments))))) 70 | 71 | (define* (rails-build store name inputs 72 | #:key 73 | (phases '(@ (gds build rails-build-system) 74 | %standard-phases)) 75 | (imported-modules %rails-build-system-modules) 76 | (system (%current-system)) 77 | (modules '((gds build rails-build-system) 78 | ((guix build ruby-build-system) #:prefix ruby:) 79 | (guix build utils))) 80 | (search-paths '()) 81 | (outputs '("out")) 82 | (precompile-rails-assets? #t) 83 | (exclude-files '("test" "spec" "tmp")) 84 | (guile #f)) 85 | "Build SOURCE with INPUTS." 86 | (define builder 87 | `(begin 88 | (use-modules ,@modules) 89 | (rails-build #:name ,name 90 | #:source ,(match (assoc-ref inputs "source") 91 | (((? derivation? source)) 92 | (derivation->output-path source)) 93 | ((source) 94 | source) 95 | (source 96 | source)) 97 | #:system ,system 98 | #:search-paths ',(map search-path-specification->sexp 99 | search-paths) 100 | #:phases ,phases 101 | #:system ,system 102 | #:outputs %outputs 103 | #:precompile-rails-assets? ,precompile-rails-assets? 104 | #:exclude-files ',exclude-files 105 | #:inputs %build-inputs))) 106 | 107 | (define guile-for-build 108 | (match guile 109 | ((? package?) 110 | (package-derivation store guile system #:graft? #f)) 111 | (#f ; the default 112 | (let* ((distro (resolve-interface '(gnu packages commencement))) 113 | (guile (module-ref distro 'guile-final))) 114 | (package-derivation store guile system #:graft? #f))))) 115 | 116 | (build-expression->derivation store name builder 117 | #:inputs inputs 118 | #:system system 119 | #:modules imported-modules 120 | #:outputs outputs 121 | #:guile-for-build guile-for-build)) 122 | 123 | (define rails-build-system 124 | (build-system 125 | (name 'rails) 126 | (description "Build system for Rails applications") 127 | (lower lower))) 128 | -------------------------------------------------------------------------------- /gds/packages/utils.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds packages utils) 2 | #:use-module (ice-9 match) 3 | #:use-module (guix utils) 4 | #:use-module (guix packages) 5 | #:use-module (guix build utils) 6 | #:use-module (guix download) 7 | #:export (github-archive)) 8 | 9 | (define* (github-archive 10 | #:optional #:key 11 | repository 12 | commit-ish 13 | (user-or-org "alphagov") 14 | (url (if repository 15 | (string-append 16 | "https://github.com/" 17 | user-or-org "/" 18 | repository "/archive/" 19 | commit-ish ".tar.gz") 20 | #f)) 21 | (hash-algo 'sha256) 22 | (hash #f)) 23 | (if (not url) 24 | (error "Either repository, or the full url must be specified")) 25 | (origin 26 | (method url-fetch) 27 | (uri url) 28 | (file-name (string-append 29 | (string-join 30 | (list user-or-org repository commit-ish) 31 | "-") 32 | ".tar.gz")) 33 | (sha256 hash))) 34 | 35 | (define-public create-bin-bundle 36 | (lambda () 37 | `(lambda* (#:key inputs outputs #:allow-other-keys) 38 | (let* 39 | ((out (assoc-ref outputs "out")) 40 | (gemfile (string-append out "/Gemfile")) 41 | (ruby 42 | (string-append (assoc-ref inputs "ruby") 43 | "/bin/ruby"))) 44 | (define* (bundle ruby-path #:optional (port #f)) 45 | (format port "#!~A 46 | ENV[\"BUNDLE_GEMFILE\"] ||= \"~A\" 47 | 48 | load Gem.bin_path(\"bundler\", \"bundler\")" ruby-path gemfile)) 49 | 50 | (mkdir-p (string-append out "/bin")) 51 | (call-with-output-file (string-append out "/bin/bundle") 52 | (lambda (port) 53 | (bundle ruby port))) 54 | (chmod (string-append out "/bin/bundle") #o544) 55 | #t)))) 56 | 57 | (define-public replace-mongoid.yml 58 | (lambda* (#:key (mongoid-version "4") 59 | (path "/config/mongoid.yml")) 60 | `(lambda* (#:key outputs #:allow-other-keys) 61 | (let ((location 62 | (string-append 63 | (assoc-ref outputs "out") ,path)) 64 | (clients-or-sessions 65 | (if (string=? ,mongoid-version "3") 66 | "sessions" 67 | "clients"))) 68 | (delete-file location) 69 | (call-with-output-file location 70 | (lambda (port) 71 | (simple-format port " 72 | development: 73 | ~A: 74 | default: 75 | uri: <%= ENV['MONGODB_URI'] %> 76 | options: 77 | write: 78 | w: majority 79 | 80 | test: 81 | ~A: 82 | default: 83 | uri: <%= ENV['MONGODB_URI'] %> 84 | options: 85 | write: 86 | w: majority 87 | 88 | production: 89 | ~A: 90 | default: 91 | uri: <%= ENV['MONGODB_URI'] %> 92 | options: 93 | write: 94 | w: majority 95 | " clients-or-sessions clients-or-sessions clients-or-sessions))) 96 | #t)))) 97 | 98 | (define-public replace-redis.yml 99 | (lambda () 100 | `(lambda* (#:key outputs #:allow-other-keys) 101 | (let ((location 102 | (string-append 103 | (assoc-ref outputs "out") 104 | "/config/redis.yml"))) 105 | (delete-file location) 106 | (call-with-output-file location 107 | (lambda (port) 108 | (simple-format port " 109 | host: <%= ENV['REDIS_HOST'] %> 110 | port: <%= ENV['REDIS_PORT'] %> 111 | namespace: <%= ENV['REDIS_NAMESPACE'] %> 112 | "))) 113 | #t)))) 114 | 115 | (define-public replace-database.yml 116 | (lambda () 117 | `(lambda* (#:key outputs #:allow-other-keys) 118 | (let ((location 119 | (string-append 120 | (assoc-ref outputs "out") 121 | "/config/database.yml"))) 122 | (delete-file location) 123 | (call-with-output-file location 124 | (lambda (port) 125 | (simple-format port " 126 | development: 127 | url: <%= ENV['DATABASE_URL'] %> 128 | 129 | test: 130 | url: <%= ENV['DATABASE_URL'] %> 131 | 132 | production: 133 | url: <%= ENV['DATABASE_URL'] %> 134 | "))) 135 | #t)))) 136 | 137 | (define-public (remove-ruby-version version) 138 | `(lambda* (#:key outputs #:allow-other-keys) 139 | (let ((location 140 | (string-append (getcwd) 141 | "/.ruby-version"))) 142 | (if (file-exists? location) 143 | (delete-file location)) 144 | (substitute* "Gemfile" 145 | (("^ruby .*") "")) 146 | #t))) 147 | 148 | (define-public use-blank-database.yml 149 | (lambda () 150 | `(lambda* (#:key outputs #:allow-other-keys) 151 | (let ((location 152 | (string-append 153 | (assoc-ref outputs "out") 154 | "/config/database.yml"))) 155 | (delete-file location) 156 | (call-with-output-file location 157 | (lambda (port) 158 | (simple-format port ""))) 159 | #t)))) 160 | 161 | (define-public (package-with-ruby ruby pkg) 162 | (package 163 | (inherit pkg) 164 | (inputs 165 | (map 166 | (match-lambda 167 | ((name pkg rest ...) 168 | (if (string=? name "ruby") 169 | `("ruby" ,ruby) 170 | (cons* name pkg rest)))) 171 | (package-inputs pkg))))) 172 | -------------------------------------------------------------------------------- /doc/local-data.md: -------------------------------------------------------------------------------- 1 | # Local Data 2 | 3 | *** 4 | __If you encounter any difficulties or problems with govuk-guix, please [open an issue][open-an-issue].__ 5 | *** 6 | [open-an-issue]: https://github.com/alphagov/govuk-guix/issues 7 | 8 | ## Contents 9 | 10 | - [Quickstart](#quickstart) 11 | - [Implementation](#implementation) 12 | 13 | ## Quickstart 14 | 15 | To check what data is available, run `govuk data list`. The results 16 | can be filtered by service name, as well as the database and date. For 17 | example, `govuk data list publishing-api --before=01/01/2017` will 18 | list data for the Publishing API that is dated before 01/01/2017. 19 | 20 | To load data, use the `load` command. It takes the same arguments as 21 | the `list` command, e.g. `govuk data load publishing-api 22 | --before=01/01/2017` will load the latest available data for the 23 | Publishing API, that is dated before 01/01/2017. 24 | 25 | ### Filtering 26 | 27 | Both the `load` and `list` commands supports `--database`, `--before` 28 | and `--after` filtering options. 29 | 30 | The `--database` option is used to filter by database, it can be 31 | specified multiple times. 32 | 33 | Older dumps can be restored (if available) by using the `--after` or 34 | `--before` options, which will select the first dataset either after 35 | or before the specified date. 36 | 37 | ## Implementation 38 | 39 | There are two parallel implementations of the `govuk data` script. The first, 40 | corresponding to the [`bin/govuk-data`][govuk-data] file is written in Guile, 41 | and the second, corresponding to the 42 | [`/bin/govuk-data-standalone`][govuk-data-standalone] file is written in 43 | Ruby. The `govuk` wrapper script will automatically run 44 | `govuk-data-standalone` if you run `govuk data` on a system without Guile, so 45 | this distinction shouldn't matter during normal use. 46 | 47 | The standalone version of `govuk data` just supports the data directory with 48 | index data source, and by default will use a AWS S3 bucket. This provides the 49 | fastest way to get the data. The non-standalone version of `govuk data` is 50 | useful for testing data extracts without having to generate a data directory 51 | to use with the standalone version of `govuk data`, however to do this, it 52 | requires Guix is available on the local machine. 53 | 54 | [govuk-data]: ../bin/govuk-data 55 | [govuk-data-standalone]: ../bin/govuk-data-standalone 56 | 57 | ### Data sources 58 | 59 | A data source can be queried as to what data it has available. Each 60 | returned item must have: 61 | 62 | - date 63 | - This should approximate to when the data was extracted. 64 | - database (e.g. PostgreSQL, MySQL, ...) 65 | - The database the data was extracted from. 66 | - services (e.g. publishing-api-service-type) 67 | - The services that can use this data. 68 | 69 | #### data-directory-with-index data source 70 | 71 | This data source works from a generated set of data, with an index file. By 72 | default, it uses a data directory fetched from an AWS S3 bucket. 73 | 74 | The data available to download from the AWS S3 bucket is populated with the 75 | [`govuk update-development-data`][govuk-update-development-data] 76 | script. This script: 77 | 78 | - Runs [`govuk download-backups`][govuk-download-backups] to download the 79 | source data from the `govuk-integration-database-backups` S3 bucket. 80 | - To save some space in storing the source data, provide smaller extracts 81 | and avoid any memory issues when passing the source data to the Guix 82 | daemon, the `download-backups` script re-compresses the data where 83 | possible to reduce the size. This can take some time. 84 | - Runs `govuk data build-data-directory-with-index` to create a directory 85 | containing all the data extracts, along with a index describing the 86 | available extracts (represented as a JSON file). To prevent the size of the 87 | bucket from continually growing, only data from the last two weeks is used. 88 | - The `build-data-directory-with-index` command involves generating every 89 | data extract, and as some of the variants require loading the data in to 90 | the respective database, and then dumping it back out, this can take 91 | some time. 92 | - The AWS S3 bucket used by `govuk data` is then updated to match the local 93 | directory, deleting any old files, and uploading any new ones. 94 | 95 | [govuk-update-development-data]: ../bin/govuk-update-development-data 96 | 97 | #### govuk-puppet-aws data source 98 | 99 | This data source is designed to be used with the govuk-puppet 100 | repository. govuk-puppet contains scripts to download data from the 101 | GOV.UK integration environment. After these scripts are run, the 102 | downloaded files are stored in the 103 | `development-vm/replication/backups` directory. 104 | 105 | These files, specifically only the downloaded archives, not any of the 106 | extracted files can be used by the local data source. 107 | 108 | To simplify the process of downloading data, the 109 | [`govuk download-backups`][govuk-download-backups] script exists, which will 110 | download data in a way that works with this data source. 111 | 112 | [govuk-download-backups]: ../bin/govuk-download-backups 113 | 114 | #### govuk-puppet data source 115 | 116 | This data source is similar to the govuk-puppet-aws data source. The migration 117 | to AWS changed the way data was managed in govuk-puppet, and this data source 118 | handles the way data was managed prior to these changes. 119 | 120 | [govuk-guix]: https://github.com/alphagov/govuk-guix 121 | -------------------------------------------------------------------------------- /doc/local-development.md: -------------------------------------------------------------------------------- 1 | # Local Development of GOV.UK related software 2 | 3 | *** 4 | __If you encounter any difficulties or problems with govuk-guix, please [open an issue][open-an-issue].__ 5 | *** 6 | [open-an-issue]: https://github.com/alphagov/govuk-guix/issues 7 | 8 | ## Contents 9 | 10 | - [Quickstart](#quickstart) 11 | - [Sharing files for local development](#sharing-files-for-local-development) 12 | - [DNS Setup](#dns-setup) 13 | 14 | ## Quickstart 15 | 16 | To access locally running services, the local DNS configuration must 17 | resolve domains like `*.dev.gov.uk` to your local machine, if this is 18 | not setup, see the [DNS Setup](#dns-setup) section for guidance on how 19 | to do this. 20 | 21 | When using govuk-guix, you can either start all services, or a subset 22 | of all services and their dependencies. To start all services, run: 23 | 24 | ``` 25 | govuk system start 26 | ``` 27 | 28 | To start only certain services, and their dependencies, list those 29 | services after the start command, for example: 30 | 31 | ``` 32 | govuk system start short-url-manager publisher 33 | ``` 34 | 35 | The [Signon][signon] application is used for authentication by other 36 | applications, and also provides links to those applications to which 37 | you have access. A user is automatically created, with access to all 38 | applications with the email address `dev@dev.gov.uk`. The passphrase 39 | randomly generated and saved so that it is the same when `govuk 40 | system` is run again. You can find out what the passphrase is by 41 | running the `govuk system passphrase` command. 42 | 43 | [signon]: https://docs.publishing.service.gov.uk/apps/signon.html 44 | 45 | If local DNS is configigured, and the system started successfully, 46 | Signon should now be reachable at: 47 | 48 | ``` 49 | http://signon.dev.gov.uk:50080/ 50 | ``` 51 | 52 | The port is intentionally non-standard (50080 rather than 80) to avoid 53 | issues around binding to low ports, and conflicts with other services 54 | using ports on the default network interface. This is a temporary 55 | workaround until more complex networking support is available. 56 | 57 | At this point, you have a GOV.UK system running locally with many of 58 | the services that you might expect. The software behind these services 59 | sits within the `/gnu/store` and cannot be modified. For guidance in 60 | starting systems for developing services, see the section on 61 | [sharing files for local development](#sharing-files-for-local-development). 62 | 63 | ## Sharing files for local development 64 | 65 | The `govuk system start` command supports the `--share` option. This 66 | uses the same syntax that can be used with the `guix system container` 67 | command. 68 | 69 | Modifying the code for a service within a running system depends on 70 | what service it is, and at the moment this may be infeasible for some 71 | services. 72 | 73 | ### Services using Rails 74 | 75 | For services using rails, it should be possible to share the source 76 | directory in to a running system, modify the files outside of the 77 | system, and for those changes to affect the running service. 78 | 79 | For example, for the short-url-manager service if you share the source 80 | directory from the host system (assumed to be 81 | `/home/dev/govuk/short-url-manager`), in to the isolated system 82 | started by `govuk system start` at the `/var/apps/short-url-manager` 83 | location, the short-url-manager service will run using the code from 84 | the host system, rather than that contained within the /gnu/store. 85 | 86 | To do this, the share option would be: 87 | 88 | ``` 89 | --share=/home/dev/govuk/short-url-manager=/var/apps/short-url-manager 90 | ``` 91 | 92 | ## DNS Setup 93 | 94 | GOV.UK services are usually deployed to separate domains, e.g. the 95 | Signon service is accessible at 96 | `signon.publishing.service.gov.uk`. Doing similarly for local 97 | devleopment can be convenient, but does require setting up the DNS 98 | configuration for your machine. 99 | 100 | ### govuk-puppet Development VM 101 | 102 | The Development VM created by using govuk-puppet has DNS setup through 103 | govuk-puppet, and this should work for using `govuk-guix`. 104 | 105 | The DNS is configured through the `/etc/hosts` file. 106 | 107 | ### NetworkManager/dnsmasq 108 | 109 | NetworkManager is commonly used to manage networking on free software 110 | operating systems, e.g. Ubuntu. 111 | 112 | NetworkManager can use dnsmasq for DNS. dnsmasq provides a easy way of 113 | setting up DNS for any `dev.gov.uk` subdomain. 114 | 115 | Setting this up can differ between systems depending on how the 116 | NetworkManager configuration is managed. Assuming that the 117 | NetworkManager configuration is in `/etc/NetworkManager`, add or 118 | change the value for `dns` to `dnsmasq` in the `main` section of 119 | `/etc/NetworkManager/NetworkManager.conf`. For example, if the 120 | configuration file looks like: 121 | 122 | ``` 123 | [main] 124 | plugins=ifupdown,keyfile 125 | 126 | [ifupdown] 127 | managed=true 128 | ``` 129 | 130 | To have NetworkManager use dnsmasq for DNS, add the line `dns=dnsmasq`. 131 | 132 | 133 | ``` 134 | [main] 135 | plugins=ifupdown,keyfile 136 | dns=dnsmasq 137 | 138 | [ifupdown] 139 | managed=true 140 | ``` 141 | 142 | To configure the `dev.gov.uk` domain, create a file called 143 | `dev.gov.uk.conf` in `/etc/NetworkManager/dnsmasq.d`. In that file, 144 | put the following. 145 | 146 | ``` 147 | address=/dev.gov.uk/127.0.0.1 148 | ``` 149 | 150 | 151 | [govuk-guix]: https://github.com/alphagov/govuk-guix 152 | [guix]: https://gnu.org/software/guix 153 | [shepherd]: https://www.gnu.org/software/shepherd/ 154 | -------------------------------------------------------------------------------- /gds/utils.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds utils) 2 | #:use-module (srfi srfi-1) 3 | #:use-module (ice-9 match) 4 | #:use-module (ice-9 vlist) 5 | #:export (levenshtein-distance 6 | find-similar-strings 7 | alist-add 8 | alist-add-no-duplicates)) 9 | 10 | (define (levenshtein-distance s1 s2) 11 | ;; Implementation using dynamic programming, which can be visualised 12 | ;; through a matrix. s1 is the string along the vertical axis, and 13 | ;; s2 along the horizontal axis. For example, with s1 as sitting and 14 | ;; s2 as kitten: 15 | ;; 16 | ;; (s2) 17 | ;; k i t t e n 18 | ;; 0 1 2 3 4 5 6 19 | ;; s 1 |1| 2 3 4 5 6 20 | ;; i 2 2 |1| 2 3 4 5 21 | ;; t 3 3 2 |1| 2 3 4 22 | ;; (s1) t 4 4 3 2 |1| 2 3 23 | ;; i 5 5 4 3 2 |2| 3 24 | ;; n 6 6 5 4 3 3 |2| 25 | ;; g 7 7 6 5 4 4 |3| 26 | ;; 27 | ;; Each row represents values taken by the previousRow and 28 | ;; currentRow variables. Note that the rows are longer than the 29 | ;; strings. The lowest cost for each row is indicated in | |. The 30 | ;; operation can be decoded by looking at the position and cost 31 | ;; relative to the lowest cost value in the previous row. 32 | (define (vlist-last vlist) 33 | (vlist-ref vlist 34 | (- (vlist-length vlist) 1))) 35 | 36 | ;; So that the rows of the matrix are shorter, reverse s1 and s2 if 37 | ;; s2 (on the horizontal axis) is longer than s2 (on the vertical 38 | ;; axis). 39 | (if (> (string-length s2) (string-length s1)) 40 | (levenshtein-distance s2 s1) 41 | 42 | ;; The distance is the value in the bottom right of the matrix, 43 | ;; which in this computation is the last entry in the final row 44 | (vlist-last 45 | (fold 46 | (lambda (i1 c1 previousRow) 47 | ;; Compute the costs for the current row, this is assembled 48 | ;; using vlist-cons, so as you go to the right across the 49 | ;; row, the costs are being put at the start the 50 | ;; list. Therefore, reverse it at the end to order it 51 | ;; correctly. 52 | (vlist-reverse 53 | (fold 54 | (lambda (i2 c2 currentRow) 55 | (vlist-cons 56 | (if (eq? c1 c2) 57 | ;; If the characters match, the cost is equal to 58 | ;; that in the previous row for the position of the 59 | ;; matching character 60 | (vlist-ref previousRow i2) 61 | 62 | ;; Characters don't match, so the cost is one 63 | ;; operation, plus the minimum cost up to this 64 | ;; point. 65 | (+ 1 66 | (min 67 | ;; The cost of deletion is 1, plus the cost 68 | ;; associated with the previous entry the 69 | ;; current row 70 | (vlist-head currentRow) 71 | 72 | ;; The cost of insertion is 1, plus the cost 73 | ;; associated with the same position in the 74 | ;; previous row 75 | (vlist-ref previousRow (+ i2 1)) 76 | 77 | ;; The cost of substitution is 1, plus the cost 78 | ;; associated with the character before this 79 | ;; one in the previous row 80 | (vlist-ref previousRow i2)))) 81 | currentRow)) 82 | (vlist-cons (+ i1 1) vlist-null) 83 | (iota (string-length s2)) 84 | (string->list s2)))) 85 | 86 | ;; Initialise the previousRow. This list represents the cost 87 | ;; of transforming an empty string to a part of s2, so the 88 | ;; value at index i is the cost to get a string of length i. 89 | (list->vlist (iota (+ 1 (string-length s2)))) 90 | 91 | (iota (string-length s1)) 92 | (string->list s1))))) 93 | 94 | (define* (find-similar-strings input strings 95 | #:optional #:key 96 | (distance-threshold 5)) 97 | (define sort-pairs 98 | (match-lambda* 99 | (((d1 . s1) (d2 . s2)) 100 | (> d1 d2)))) 101 | 102 | (map cdr 103 | (stable-sort (filter-map 104 | (lambda (string) 105 | (let ((distance 106 | (levenshtein-distance string input))) 107 | (if (< distance distance-threshold) 108 | (cons distance string) 109 | #f))) 110 | strings) 111 | sort-pairs))) 112 | 113 | (define (alist-add key value alist) 114 | (if (null? alist) 115 | (list (cons key (list value))) 116 | (if (equal? (caar alist) key) 117 | (cons (cons key 118 | (cons value 119 | (cdr (first alist)))) 120 | (cdr alist)) 121 | (cons (car alist) 122 | (alist-add key value (cdr alist)))))) 123 | 124 | (define* (alist-add-no-duplicates key value alist #:optional (= equal?)) 125 | (if (null? alist) 126 | (list (cons key (list value))) 127 | (if (equal? (caar alist) key) 128 | (cons (cons key 129 | (delete-duplicates 130 | (cons value 131 | (cdr (first alist))) 132 | =)) 133 | (cdr alist)) 134 | (cons (car alist) 135 | (alist-add key value (cdr alist)))))) 136 | -------------------------------------------------------------------------------- /gds/packages/govuk/ruby.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds packages govuk ruby) 2 | #:use-module (guix download) 3 | #:use-module ((guix licenses) #:prefix license:) 4 | #:use-module (guix packages) 5 | #:use-module (guix build-system ruby) 6 | #:use-module (gnu packages ruby) 7 | #:use-module (gnu packages rails) 8 | #:use-module (gds packages third-party ruby)) 9 | 10 | (define-public ruby-gds-sso 11 | (package 12 | (name "ruby-gds-sso") 13 | (version "15.0.1") 14 | (source 15 | (origin 16 | (method url-fetch) 17 | (uri (rubygems-uri "gds-sso" version)) 18 | (sha256 19 | (base32 20 | "0dvwb7mz2xayhrfsg832qfgj8cc6xxifddhmzahjzv07zh0jckxp")))) 21 | (build-system ruby-build-system) 22 | (arguments 23 | '(#:tests? #f)) 24 | (propagated-inputs 25 | `(("ruby-multi-json" ,ruby-multi-json) 26 | ("ruby-oauth2" ,ruby-oauth2) 27 | ("ruby-omniauth" ,ruby-omniauth) 28 | ("ruby-omniauth-gds" ,ruby-omniauth-gds) 29 | ("ruby-rails" ,ruby-rails) 30 | ("ruby-warden" ,ruby-warden) 31 | ("ruby-warden-oauth2" ,ruby-warden-oauth2))) 32 | (synopsis "Client for GDS' OAuth 2-based SSO") 33 | (description "Client for GDS' OAuth 2-based SSO") 34 | (home-page "https://github.com/alphagov/gds-sso") 35 | (license license:expat))) 36 | 37 | (define-public ruby-govuk-admin-template 38 | (package 39 | (name "ruby-govuk-admin-template") 40 | (version "6.7.0") 41 | (source 42 | (origin 43 | (method url-fetch) 44 | (uri (rubygems-uri "govuk_admin_template" version)) 45 | (sha256 46 | (base32 47 | "19wwh1mn1kla8wp3baxq0s58agiik0fbxqli4sn8ymqlrzi86xnd")))) 48 | (build-system ruby-build-system) 49 | (arguments 50 | '(#:tests? #f)) 51 | (propagated-inputs 52 | `(("ruby-bootstrap-sass" ,ruby-bootstrap-sass) 53 | ("ruby-jquery-rails" ,ruby-jquery-rails) 54 | ("ruby-rails" ,ruby-rails))) 55 | (synopsis 56 | "Styles, scripts and templates for GOV.UK admin applications") 57 | (description 58 | "Styles, scripts and templates for GOV.UK admin applications") 59 | (home-page 60 | "https://github.com/alphagov/govuk_admin_template") 61 | (license #f))) 62 | 63 | (define-public ruby-govuk-document-types 64 | (package 65 | (name "ruby-govuk-document-types") 66 | (version "0.9.2") 67 | (source 68 | (origin 69 | (method url-fetch) 70 | (uri (rubygems-uri "govuk_document_types" version)) 71 | (sha256 72 | (base32 73 | "0kyymwvnm3sdmcf1ip7cnkpclvs4il2vklh64fi3hbl61iy9k9y6")))) 74 | (build-system ruby-build-system) 75 | (arguments 76 | '(#:test-target "spec")) 77 | (native-inputs 78 | `(("bundler" ,bundler) 79 | ("ruby-rspec" ,ruby-rspec))) 80 | (synopsis "Gem to share document type groupings") 81 | (description 82 | "Gem to share document type groupings") 83 | (home-page 84 | "https://github.com/alphagov/govuk_document_types") 85 | (license license:expat))) 86 | 87 | (define-public ruby-govuk-taxonomy-helpers 88 | (package 89 | (name "ruby-govuk-taxonomy-helpers") 90 | (version "1.0.0") 91 | (source 92 | (origin 93 | (method url-fetch) 94 | (uri (rubygems-uri "govuk_taxonomy_helpers" version)) 95 | (sha256 96 | (base32 97 | "0sshqz1viwm6drql9rcfk7056ajxw5vnfpv5m3zs90ab0miphin7")))) 98 | (build-system ruby-build-system) 99 | (arguments 100 | '(#:test-target "spec")) 101 | (native-inputs 102 | `(("bundler" ,bundler))) 103 | (synopsis 104 | "Parses the taxonomy of GOV.UK into a browseable tree structure.") 105 | (description 106 | "Parses the taxonomy of GOV.UK into a browseable tree structure.") 107 | (home-page 108 | "https://github.com/alphagov/govuk_taxonomy_helpers") 109 | (license license:expat))) 110 | 111 | (define-public ruby-omniauth-gds 112 | (package 113 | (name "ruby-omniauth-gds") 114 | (version "3.2.1") 115 | (source 116 | (origin 117 | (method url-fetch) 118 | (uri (rubygems-uri "omniauth-gds" version)) 119 | (sha256 120 | (base32 121 | "1nkqxkn0fqnllgn34v54y33vy812pxwkzavgzi2a4a6rnpfbj4pv")))) 122 | (build-system ruby-build-system) 123 | (arguments 124 | '(#:tests? #f 125 | #:phases 126 | (modify-phases %standard-phases 127 | (add-after 'extract-gemspec 'loosen-gemspec-dependencies 128 | (lambda _ 129 | (substitute* "omniauth-gds.gemspec" 130 | (("%q.freeze, \\[.*") 131 | "%q.freeze, ['~> 1'])\n")) 132 | #t))))) 133 | (native-inputs 134 | `(("bundler" ,bundler))) 135 | (propagated-inputs 136 | `(("ruby-multi-json" ,ruby-multi-json) 137 | ("ruby-omniauth-oauth2" ,ruby-omniauth-oauth2))) 138 | (synopsis "Omniauth strategy for GDS oauth2 provider") 139 | (description 140 | "Omniauth strategy for GDS oauth2 provider.") 141 | (home-page "") 142 | (license #f))) 143 | 144 | (define-public ruby-plek 145 | (package 146 | (name "ruby-plek") 147 | (version "4.0.0") 148 | (source 149 | (origin 150 | (method url-fetch) 151 | (uri (rubygems-uri "plek" version)) 152 | (sha256 153 | (base32 154 | "1q8ywmq3ixaxg24k42dg0bribh9wwb8wagymapi4z5jbjmby42m8")))) 155 | (build-system ruby-build-system) 156 | (arguments 157 | '(#:tests? #f)) ;; No tests included 158 | (synopsis 159 | "Find the right hostname for each service in an environment-dependent manner") 160 | (description 161 | "Find the right hostname for each service in an environment-dependent manner") 162 | (home-page "https://github.com/alphagov/plek") 163 | (license license:expat))) 164 | -------------------------------------------------------------------------------- /gds/data/transformations/mysql.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds data transformations mysql) 2 | #:use-module (srfi srfi-1) 3 | #:use-module (ice-9 match) 4 | #:use-module (guix gexp) 5 | #:use-module (gnu packages base) 6 | #:use-module (gnu packages admin) 7 | #:use-module (gnu packages compression) 8 | #:use-module (gnu packages pv) 9 | #:use-module (gnu services) 10 | #:use-module (gnu services databases) 11 | #:use-module (gds data data-extract) 12 | #:use-module (gds services utils databases mysql) 13 | #:export (with-mysql 14 | 15 | mysql-load-extracts)) 16 | 17 | (define* (with-mysql 18 | mysql-service 19 | gexp-to-run 20 | #:key (base-directory #~(string-append 21 | (getcwd) 22 | "/mysql"))) 23 | 24 | (let ((mysql ((@@ (gnu services databases) mysql-configuration-mysql) 25 | (service-value mysql-service)))) 26 | (with-imported-modules '((guix build utils)) 27 | #~(begin 28 | (add-to-load-path #$(file-append shepherd 29 | "/share/guile/site/" 30 | (effective-version))) 31 | 32 | (use-modules (shepherd service) 33 | (guix build utils)) 34 | 35 | (define base-directory #$base-directory) 36 | 37 | (setenv "PATH" 38 | (list->search-path-as-string 39 | (cons* #$(file-append mysql "/bin") 40 | #$(file-append pv "/bin") 41 | #$(file-append gzip "/bin") 42 | (string-append #$xz "/bin") 43 | ;; TODO: mysql_install_db uses mkdir and sed 44 | #$(file-append coreutils "/bin") 45 | #$(file-append sed "/bin") 46 | (search-path-as-string->list (getenv "PATH"))) 47 | ":")) 48 | 49 | (define configuration-file 50 | (string-append (getcwd) "/my.cnf")) 51 | 52 | (define socket-file 53 | (string-append (getcwd) "/mysqld.sock")) 54 | 55 | (setenv "MYSQL_UNIX_PORT" socket-file) 56 | 57 | (call-with-output-file configuration-file 58 | (lambda (port) 59 | (display "[mysqld]\n" port) 60 | (display (string-append "datadir=" base-directory "\n") 61 | port) 62 | (display (string-append "socket=" socket-file "\n") 63 | port) 64 | (display "max_allowed_packet=1G\n" port) 65 | (display "\n" port))) 66 | 67 | (mkdir-p base-directory) 68 | (invoke #$(file-append mysql "/bin/mysql_install_db") 69 | (string-append "--datadir=" base-directory)) 70 | 71 | (simple-format #t "\nSuccessfully boostrapped MySQL\n\n") 72 | (force-output) 73 | 74 | ;; TODO: This might work in the future, but currently fails 75 | ;; as the mysql.server script and mysqld_safe use sed, 76 | ;; hostname, ... and can't access them 77 | (define (mysql.server . args) 78 | (let ((command 79 | `(#$(file-append mysql 80 | "/share/mysql/support-files/mysql.server") 81 | ,@args))) 82 | (simple-format #t "running: ~A\n" (string-join command " ")) 83 | (force-output) 84 | (apply invoke command))) 85 | 86 | (define (start-mysql) 87 | ((make-forkexec-constructor 88 | (list #$(file-append mysql "/bin/mysqld") 89 | (string-append "--defaults-file=" configuration-file) 90 | "--innodb_buffer_pool_size=1GB" 91 | "--skip-innodb_doublewrite" 92 | "--innodb_flush_log_at_trx_commit=0" 93 | "--innodb_flush_method=nosync" 94 | "--innodb_io_capacity=2000" 95 | "--innodb_io_capacity_max=3000" 96 | "--pid-file=/tmp/mysql.pid") 97 | #:pid-file "/tmp/mysql.pid"))) 98 | 99 | (let ((mysql-pid (start-mysql)) 100 | (result 101 | (#$gexp-to-run))) 102 | 103 | (simple-format #t "Stopping MySQL\n") 104 | (force-output) 105 | ((make-kill-destructor) mysql-pid) 106 | ;; TODO: Fix this 107 | (sleep 10) 108 | (simple-format #t "Finished sleeping after stopping MySQL\n") 109 | (force-output) 110 | 111 | result))))) 112 | 113 | (define (mysql-load-extracts extracts-and-database-connection-configs) 114 | (define operation 115 | (with-imported-modules '((gds data transformations build mysql)) 116 | #~(lambda _ 117 | (use-modules (gds data transformations build mysql)) 118 | #$@(append-map 119 | (match-lambda 120 | ((data-extract . database-connection-configs) 121 | (map 122 | (lambda (database-connection-config) 123 | #~(let ((database #$(mysql-connection-config-database 124 | database-connection-config))) 125 | (invoke 126 | "mysql" "--user=root" "-e" 127 | (string-append 128 | "CREATE DATABASE " database ";" 129 | "GRANT ALL ON " database ".* TO ''@'localhost';")) 130 | 131 | (decompress-file-and-pipe-to-mysql 132 | #$(data-extract-file data-extract) 133 | database))) 134 | database-connection-configs))) 135 | extracts-and-database-connection-configs)))) 136 | 137 | #~(begin 138 | #$(with-mysql 139 | (service mysql-service-type) 140 | operation))) 141 | -------------------------------------------------------------------------------- /gds/scripts/govuk/system/available-services.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds scripts govuk system available-services) 2 | #:use-module (srfi srfi-1) 3 | #:use-module (ice-9 match) 4 | #:use-module (json) 5 | #:use-module (guix packages) 6 | #:use-module (guix download) 7 | #:use-module (guix git-download) 8 | #:use-module (gnu services) 9 | #:use-module (gnu services shepherd) 10 | #:use-module (gnu system) 11 | #:use-module (gds services govuk) 12 | #:use-module (gds systems govuk development) 13 | #:use-module (gds scripts utils) 14 | #:export (available-services)) 15 | 16 | (define (shepherd-services service) 17 | (let* ((shepherd-service-extension 18 | (find (lambda (service-extension) 19 | (eq? (service-extension-target service-extension) 20 | shepherd-root-service-type)) 21 | (service-type-extensions 22 | (service-kind service)))) 23 | (compute 24 | (service-extension-compute shepherd-service-extension))) 25 | (compute 26 | (service-value (matching-service-from-development-os 27 | service))))) 28 | 29 | (define (package service) 30 | (let ((value (service-value service))) 31 | (and (list? value) 32 | (find package? value)))) 33 | 34 | (define (group service) 35 | (any (lambda (group) 36 | (if (memq (service-kind service) 37 | (map service-kind 38 | (service-group-services group))) 39 | group 40 | #f)) 41 | service-groups)) 42 | 43 | (define (matching-service-from-development-os service) 44 | (find (lambda (development-os-service) 45 | (eq? (service-kind development-os-service) 46 | (service-kind service))) 47 | (operating-system-user-services govuk-development-os))) 48 | 49 | (define (display-available-services-in-json) 50 | (define (origin-sexp origin) 51 | (cond 52 | ((eq? (origin-method origin) url-fetch) 53 | `((uri . ,(origin-uri origin)))) 54 | ((eq? (origin-method origin) git-fetch) 55 | `((uri . ,(let ((git-reference (origin-uri origin))) 56 | `((url . ,(git-reference-url git-reference)) 57 | (commit . ,(git-reference-commit git-reference))))))) 58 | (else 59 | (error "Unhandled origin method")))) 60 | 61 | (define (package-sexp package) 62 | `((name . ,(package-name package)) 63 | (version . ,(package-version package)) 64 | (homepage . ,(package-home-page package)) 65 | (source . ,(origin-sexp (package-source package))))) 66 | 67 | (define (shepherd-services-sexp shepherd-services) 68 | (map (lambda (shepherd-service) 69 | `(,(shepherd-service-canonical-name 70 | shepherd-service) 71 | . 72 | ((provision . ,(shepherd-service-provision 73 | shepherd-service)) 74 | (requirement . ,(shepherd-service-requirement 75 | shepherd-service))))) 76 | shepherd-services)) 77 | 78 | (define (service-sexp service) 79 | `((name . ,(service-type-name (service-kind service))) 80 | 81 | ,@(or (and=> (service-type-description (service-kind service)) 82 | (lambda (description) 83 | `((description . ,description)))) 84 | '()) 85 | 86 | (package . ,(package-sexp (package service))) 87 | (shepherd-services . ,(shepherd-services-sexp 88 | (shepherd-services service))))) 89 | 90 | (scm->json 91 | (map (match-lambda 92 | (($ name description services) 93 | `((name . ,name) 94 | (description . ,description) 95 | (services . ,(map service-sexp 96 | services))))) 97 | service-groups) 98 | #:pretty #t)) 99 | 100 | (define (display-available-services) 101 | (for-each (lambda (service) 102 | (simple-format #t "~A:" (service-type-name 103 | (service-kind service))) 104 | (newline) 105 | 106 | (and=> (package service) 107 | (lambda (package) 108 | (simple-format #t " package: ~A@~A\n" 109 | (package-name package) 110 | (package-version package)) 111 | (newline))) 112 | 113 | (and=> (group service) 114 | (lambda (group) 115 | (simple-format #t " group: ~A\n" 116 | (service-group-name group)) 117 | (newline))) 118 | 119 | (display " shepherd services:\n") 120 | (for-each 121 | (lambda (shepherd-service) 122 | (simple-format #t " - name: ~A\n" 123 | (shepherd-service-canonical-name 124 | shepherd-service)) 125 | (simple-format #t " provision: ~A\n" 126 | (string-join (map symbol->string 127 | (shepherd-service-provision 128 | shepherd-service)) 129 | ", ")) 130 | (simple-format #t " requirement: ~A\n" 131 | (string-join (map symbol->string 132 | (shepherd-service-requirement 133 | shepherd-service)) 134 | ", "))) 135 | (shepherd-services service)) 136 | (newline)) 137 | govuk-services)) 138 | 139 | (define (available-services opts) 140 | (if (option-value opts 'json-output? #:default #f) 141 | (display-available-services-in-json) 142 | (display-available-services))) 143 | -------------------------------------------------------------------------------- /gds/scripts/govuk/system/build.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds scripts govuk system build) 2 | #:use-module (srfi srfi-1) 3 | #:use-module (guix derivations) 4 | #:use-module (guix grafts) 5 | #:use-module (guix monads) 6 | #:use-module (guix store) 7 | #:use-module (guix gexp) 8 | #:use-module (guix scripts build) 9 | #:use-module (gnu system) 10 | #:use-module (gnu system vm) 11 | #:use-module (gnu system file-systems) 12 | #:use-module (gds systems utils packer) 13 | #:use-module (gds scripts utils) 14 | #:use-module (gds scripts govuk system) 15 | #:export (build)) 16 | 17 | (define (vm-image-and-system os opts) 18 | (define vm-os 19 | (let ((base-os 20 | (virtualized-operating-system 21 | (alter-services-for-vm os) 22 | '()))) 23 | (operating-system 24 | (inherit base-os) 25 | (file-systems 26 | (map (lambda (fs) 27 | (if (string=? (file-system-mount-point fs) 28 | "/gnu/store") 29 | (file-system 30 | (inherit fs) 31 | (device "TAG_gnu_store")) 32 | fs)) 33 | (operating-system-file-systems base-os)))))) 34 | 35 | (with-store store 36 | (set-build-options-from-command-line store opts) 37 | 38 | (run-with-store store 39 | (mbegin %store-monad 40 | (set-grafting #f) 41 | (mlet* %store-monad 42 | ((item 43 | (gexp->derivation 44 | "vm-image-and-system" 45 | #~(begin 46 | (mkdir #$output) 47 | (chdir #$output) 48 | (symlink #$((operating-system-derivation vm-os) store) 49 | "system") 50 | (symlink #$((system-qemu-image/shared-store 51 | vm-os 52 | ;; TODO: This shouldn't be necessary 53 | #:disk-image-size (* 80 (expt 2 20))) 54 | store) 55 | "image"))))) 56 | (mbegin %store-monad 57 | (built-derivations (list item)) 58 | (return (derivation->output-path item)))))))) 59 | 60 | (define (disk-image os opts) 61 | (with-store store 62 | (set-build-options-from-command-line store opts) 63 | 64 | (run-with-store store 65 | (mbegin %store-monad 66 | (set-grafting #f) 67 | (mlet* %store-monad 68 | ((item (system-disk-image 69 | (alter-services-for-vm os) 70 | #:name "disk-image" 71 | #:disk-image-size 'guess))) 72 | 73 | (mbegin %store-monad 74 | (built-derivations (list item)) 75 | (return (derivation->output-path item)))))))) 76 | 77 | (define (aws-packer-template os opts) 78 | (with-store store 79 | (set-build-options-from-command-line store opts) 80 | 81 | (run-with-store store 82 | (mbegin %store-monad 83 | (set-grafting #f) 84 | (mlet* %store-monad 85 | ((item (lower-object 86 | (packer-template-for-govuk-system-init 87 | (option-value opts 'ami-name) 88 | (cddr (command-line)) 89 | #:data-snapshot (option-value opts 'data-snapshot))))) 90 | 91 | (mbegin %store-monad 92 | (built-derivations (list item)) 93 | (return (derivation->output-path item)))))))) 94 | 95 | (define (aws-packer-ami os opts) 96 | (define (sudo-path) 97 | (find 98 | file-exists? 99 | '("/run/setuid-programs/sudo" 100 | "/usr/bin/sudo"))) 101 | 102 | (define (run . args) 103 | (let ((command 104 | (if (eq? (getuid) 1) 105 | args 106 | (cons* (sudo-path) "-E" args)))) 107 | (format #t "Running command:~% ~a~2%" (string-join command " ")) 108 | (apply execl 109 | (first command) 110 | command))) 111 | 112 | (define build-packer-template-script 113 | (with-store store 114 | (set-build-options-from-command-line store opts) 115 | 116 | (run-with-store store 117 | (mbegin %store-monad 118 | (set-grafting #f) 119 | (mlet* %store-monad 120 | ((item (packer-build-template-script 121 | (packer-template-for-govuk-system-init 122 | (option-value opts 'ami-name) 123 | (cddr (command-line)) 124 | #:data-snapshot (option-value opts 'data-snapshot))))) 125 | 126 | (mbegin %store-monad 127 | (built-derivations (list item)) 128 | (return (derivation->output-path item)))))))) 129 | 130 | (run build-packer-template-script)) 131 | 132 | (define (build opts) 133 | (let* ((type (assq-ref opts 'type)) 134 | (os (opts->operating-system 135 | (if (memq type '(aws-packer-template aws-packer-ami)) 136 | ;; If this system is for an AMI, don't pass the 137 | ;; data-snapshot through, as this is handled in 138 | ;; the packer template 139 | (alist-delete 'data-snapshot opts) 140 | opts) 141 | #:default-read-bundle-install-input-as-tar-archive? 142 | (assq-ref 143 | '((vm-image-and-system . #t) 144 | (vm-start-script . #t) 145 | (aws-packer-template . #f) 146 | (aws-packer-ami . #f) 147 | (container-start-script . #f) 148 | (disk-image . #f)) 149 | type))) 150 | (build-function 151 | (assq-ref 152 | `((vm-image-and-system . ,vm-image-and-system) 153 | (vm-start-script . ,vm-start-script) 154 | (aws-packer-template . ,aws-packer-template) 155 | (aws-packer-ami . ,aws-packer-ami) 156 | (disk-image . ,disk-image) 157 | (container-start-script . ,container-start-script)) 158 | type)) 159 | (output (build-function os opts))) 160 | 161 | (display-system-information os) 162 | (newline) 163 | (display output) 164 | (newline) 165 | (exit 0))) 166 | -------------------------------------------------------------------------------- /bin/govuk-refresh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/guile --no-auto-compile 2 | -*- scheme -*- 3 | !# 4 | 5 | ;; To allow this script to be run directly, even from the Git 6 | ;; repository, check if the environment is setup by checking if the 7 | ;; (gds services) module is loadable. If it's not loadable, start this 8 | ;; script again, but use the guix-pre-inst-env helper to setup the 9 | ;; environment. 10 | (catch 11 | #t 12 | (lambda () 13 | (resolve-interface '(gds services))) 14 | (lambda args 15 | (let* ((govuk-guix-root 16 | (or (and=> (current-filename) 17 | (lambda (x) 18 | (dirname (dirname x)))) 19 | (getenv "GOVUK_GUIX_ROOT") 20 | (error "Unable to locate the govuk-guix root"))) 21 | (command-full-path 22 | (string-append govuk-guix-root "/bin/govuk-refresh"))) 23 | (apply execlp 24 | "bash" 25 | "--" 26 | (string-append govuk-guix-root "/guix-pre-inst-env") 27 | "guile" 28 | command-full-path 29 | (cdr (command-line)))))) 30 | 31 | (use-modules 32 | (srfi srfi-1) 33 | (srfi srfi-11) 34 | (srfi srfi-26) 35 | (srfi srfi-37) 36 | (ice-9 match) 37 | (guix ui) 38 | (gcrypt hash) 39 | (guix store) 40 | (guix scripts) 41 | (guix packages) 42 | (guix upstream) 43 | (gds packages utils bundler)) 44 | 45 | (define updaters 46 | (list (@ (guix import github) %github-updater) 47 | (@ (guix import gem) %gem-updater))) 48 | 49 | (define (all-packages) 50 | (filter 51 | package? 52 | (append-map 53 | (lambda (module) 54 | (module-map 55 | (lambda (name var) 56 | (variable-ref var)) 57 | (resolve-interface module))) 58 | '((gds packages govuk) 59 | (gds packages govuk ruby))))) 60 | 61 | (define (get-matching-packages args) 62 | (map (lambda (name) 63 | (or (find (lambda (pkg) 64 | (string=? name 65 | (package-name pkg))) 66 | (all-packages)) 67 | (leave (G_ "Could not find a package matching ~A") 68 | name))) 69 | args)) 70 | 71 | (define (commit-version-change package new-version) 72 | (define (run . args) 73 | (unless (zero? (apply system* args)) 74 | (leave (G_ "command failed: ~A") 75 | (string-join args)))) 76 | 77 | (let ((name "Package Updater") 78 | (email "govuk-guix-package-updater@digital.cabinet-office.gov.uk") 79 | (repo-location (dirname (dirname (current-filename))))) 80 | (run "git" "-C" repo-location 81 | "add" 82 | "gds/packages/govuk.scm" 83 | "gds/packages/govuk/ruby.scm") 84 | (setenv "GIT_COMMITTER_NAME" name) 85 | (setenv "GIT_COMMITTER_EMAIL" email) 86 | (run "git" 87 | "-C" repo-location 88 | "commit" 89 | (simple-format #f "--author=~A <~A>" name email) 90 | "-m" 91 | (simple-format 92 | #f "Update ~A from ~A to ~A" 93 | (package-name package) (package-version package) new-version)))) 94 | 95 | (define (refresh-package store package commit? force?) 96 | (define (refresh-package-source package source tarball) 97 | (update-package-source package 98 | source 99 | (call-with-input-file 100 | tarball 101 | port-sha256))) 102 | 103 | (define (refresh-bundle-package-if-present package tarball) 104 | (and=> (extract-bundle-package-from-package package) 105 | (lambda (bundle-pkg) 106 | (update-bundle-package-source 107 | (bundle-package 108 | (inherit bundle-pkg) 109 | (location (bundle-package-location bundle-pkg)) 110 | (source tarball)))))) 111 | 112 | (simple-format #t "\nChecking latest release of ~A\n" 113 | (package-name package)) 114 | (let-values (((version tarball source) 115 | (package-update store package updaters))) 116 | (if (and (let ((source-tarball-changed 117 | (if version 118 | (refresh-package-source package source tarball) 119 | #f)) 120 | (bundle-package-changed 121 | (if (or version force?) 122 | (refresh-bundle-package-if-present 123 | package 124 | (or tarball 125 | ;; When force? is true, tarball could be #f 126 | ;; if no new version is available, in which 127 | ;; case, fallback to the package source. 128 | (package-source package))) 129 | #f))) 130 | (or source-tarball-changed 131 | bundle-package-changed)) 132 | commit?) 133 | (commit-version-change package version)))) 134 | 135 | (define %default-options 136 | '((commit? . #f) 137 | (force? . #f))) 138 | 139 | (define options 140 | ;; Specifications of the command-line options. 141 | (list (option '("commit") #f #f 142 | (lambda (opt name arg result) 143 | (alist-cons 'commit? #t 144 | (alist-delete 'commit? result)))) 145 | (option '("force") #f #f 146 | (lambda (opt name arg result) 147 | (alist-cons 'force? #t 148 | (alist-delete 'force? result)))))) 149 | 150 | 151 | (define (option-values opts key) 152 | (reverse 153 | (filter-map (match-lambda 154 | ((head . tail) 155 | (and (eq? key head) tail)) 156 | (_ #f)) 157 | opts))) 158 | 159 | (define (govuk-refresh . args) 160 | (display "\n") 161 | (with-error-handling 162 | (let* ((opts (parse-command-line (cdr args) options (list %default-options)))) 163 | (with-store store 164 | (for-each (cut refresh-package 165 | store 166 | <> 167 | (assoc-ref opts 'commit?) 168 | (assoc-ref opts 'force?)) 169 | (let ((package-names (option-values opts 'argument))) 170 | (if (null? package-names) 171 | (all-packages) 172 | (get-matching-packages package-names)))))))) 173 | 174 | (apply govuk-refresh (command-line)) 175 | -------------------------------------------------------------------------------- /gds/systems/govuk/test.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds systems govuk test) 2 | #:use-module (srfi srfi-1) 3 | #:use-module (srfi srfi-26) 4 | #:use-module (guix gexp) 5 | #:use-module (gnu system) 6 | #:use-module (gnu packages certs) 7 | #:use-module (gnu packages tls) 8 | #:use-module (gnu services) 9 | #:use-module (gnu services networking) 10 | #:use-module (gnu services web) 11 | #:use-module (gds packages govuk) 12 | #:use-module (gds services) 13 | #:use-module (gds services rails) 14 | #:use-module (gds services utils) 15 | #:use-module (gds services utils databases) 16 | #:use-module (gds services utils databases postgresql) 17 | #:use-module (gds services utils databases mysql) 18 | #:use-module (gds services utils databases mongodb) 19 | #:use-module (gds services govuk) 20 | #:use-module (gds services govuk signon) 21 | #:use-module (gds services govuk search-api) 22 | #:use-module (gds services govuk nginx) 23 | #:use-module (gds services govuk router) 24 | #:use-module (gds services govuk plek) 25 | #:use-module (gds services govuk routing-configuration) 26 | #:use-module (gds systems utils) 27 | #:use-module (gds systems govuk production) 28 | #:export (govuk-test-os)) 29 | 30 | (define (setup-services-for-test-os services) 31 | (define apply-general-configuration 32 | (let 33 | ((service-setup-functions 34 | ;; Service setup functions, order alphabetically if possible, 35 | ;; and add comments to indicate any interdependencies in the 36 | ;; configuration 37 | (list 38 | (cut set-routing-configuration-for-services <> 39 | #:use-high-ports? #t 40 | #:use-https? 'development 41 | #:app-domain "test.gov.uk" 42 | #:web-domain "test.gov.uk") 43 | ;; TODO: ensure-database-user-exists-on-service-startup and 44 | ;; configure-rails-services-database setup must happen after 45 | ;; update-database-connection-config-ports, or the wrong 46 | ;; database connection configuration is used. 47 | (cut map ensure-database-user-exists-on-service-startup <>) 48 | (cut map run-db:setup-if-postgresql-or-mysql-is-used <>)))) 49 | 50 | (apply compose (reverse service-setup-functions)))) 51 | 52 | (modify-services (apply-general-configuration services) 53 | (publisher-service-type 54 | parameters => 55 | (map 56 | (lambda (parameter) 57 | (if (service-startup-config? parameter) 58 | (service-startup-config-with-additional-environment-variables 59 | parameter 60 | '(("DISABLE_EMAIL" . "true"))) 61 | parameter)) 62 | parameters)) 63 | (search-api-service-type 64 | parameters => 65 | (map 66 | (lambda (parameter) 67 | (if (service-startup-config? parameter) 68 | (service-startup-config-add-pre-startup-scripts 69 | parameter 70 | `((create-all-indices 71 | . ,#~(lambda () 72 | (setenv "SEARCH_INDEX" "all") 73 | (run-command "bundle" "exec" "rake" 74 | "search:create_all_indices"))))) 75 | parameter)) 76 | parameters)) 77 | (router-service-type 78 | parameters => 79 | (map 80 | (lambda (parameter) 81 | (if (router-config? parameter) 82 | (router-config 83 | (inherit parameter) 84 | ;; Performance for the initial requests to frontend apps seems 85 | ;; to be poor, so until this is improved, extend the timeout for 86 | ;; the router 87 | (backend-header-timeout "60s")) 88 | parameter)) 89 | parameters)) 90 | (whitehall-service-type 91 | parameters => 92 | (map 93 | (lambda (parameter) 94 | (if (service-startup-config? parameter) 95 | (service-startup-config-add-pre-startup-scripts 96 | parameter 97 | `((publish-finders 98 | . ,#~(lambda () 99 | (run-command "rake" "db:seed"))))) 100 | parameter)) 101 | parameters)) 102 | (contacts-admin-service-type 103 | parameters => 104 | (map 105 | (lambda (parameter) 106 | (if (service-startup-config? parameter) 107 | (service-startup-config-add-pre-startup-scripts 108 | parameter 109 | `((publish-finders 110 | . ,#~(lambda () 111 | (run-command "rake" "db:seed"))) 112 | (publish-finders 113 | . ,#~(lambda () 114 | (run-command "rake" "finders:publish"))))) 115 | parameter)) 116 | parameters)) 117 | (collections-publisher-service-type 118 | parameters => 119 | (map 120 | (lambda (parameter) 121 | (if (service-startup-config? parameter) 122 | (service-startup-config-add-pre-startup-scripts 123 | parameter 124 | `((publish-api-organisations-route 125 | . ,#~(lambda () 126 | (run-command 127 | "rake" 128 | "publishing_api:publish_organisations_api_route"))))) 129 | parameter)) 130 | parameters)) 131 | (specialist-publisher-service-type 132 | parameters => 133 | (map 134 | (lambda (parameter) 135 | (if (service-startup-config? parameter) 136 | (service-startup-config-add-pre-startup-scripts 137 | parameter 138 | `((publish-finders 139 | . ,#~(lambda () 140 | (run-command "rake" "publishing_api:publish_finders"))))) 141 | parameter)) 142 | parameters)) 143 | (router-service-type 144 | parameters => 145 | (map 146 | (lambda (parameter) 147 | (if (router-config? parameter) 148 | (router-config 149 | (inherit parameter) 150 | ;; Performance for the initial requests to frontend apps seems 151 | ;; to be poor, so until this is improved, extend the timeout for 152 | ;; the router 153 | (backend-header-timeout "60s")) 154 | parameter)) 155 | parameters)))) 156 | 157 | (define govuk-test-os 158 | (operating-system 159 | (inherit govuk-production-os) 160 | (host-name "govuk-test") 161 | (services (setup-services-for-test-os 162 | (operating-system-user-services govuk-production-os))))) 163 | -------------------------------------------------------------------------------- /gds/services.scm: -------------------------------------------------------------------------------- 1 | (define-module (gds services) 2 | #:use-module (ice-9 match) 3 | #:use-module (guix records) 4 | #:use-module (guix gexp) 5 | #:use-module (gnu services) 6 | #:export ( 7 | service-startup-config 8 | service-startup-config? 9 | service-startup-config-environment-variables 10 | service-startup-config-pre-startup-scripts 11 | service-startup-config-root-pre-startup-scripts 12 | 13 | service-startup-config-with-additional-environment-variables 14 | service-startup-config-add-pre-startup-scripts 15 | service-extensions-modify-parameters 16 | service-type-extensions-modify-parameters 17 | run-pre-startup-scripts-gexp 18 | 19 | set-aws-xray-context-missing)) 20 | 21 | (define-record-type* 22 | service-startup-config make-service-startup-config 23 | service-startup-config? 24 | (environment-variables service-startup-config-environment-variables 25 | (default '())) 26 | (pre-startup-scripts service-startup-config-pre-startup-scripts 27 | (default '())) 28 | (root-pre-startup-scripts service-startup-config-root-pre-startup-scripts 29 | (default '()))) 30 | 31 | (define (service-startup-config-with-additional-environment-variables 32 | ssc 33 | environment-variables) 34 | (service-startup-config 35 | (inherit ssc) 36 | (environment-variables 37 | (append 38 | environment-variables 39 | (filter 40 | (match-lambda 41 | ((key . value) 42 | (not (assoc-ref environment-variables key)))) 43 | (service-startup-config-environment-variables ssc)))))) 44 | 45 | (define* (service-startup-config-add-pre-startup-scripts 46 | ssc 47 | scripts 48 | #:optional #:key (run-as-root #f)) 49 | (define (filter-out-replaced-scripts old-scripts) 50 | (let 51 | ((new-keys 52 | (map car scripts))) 53 | (filter 54 | (match-lambda 55 | ((key . value) 56 | (not (memq key new-keys)))) 57 | old-scripts))) 58 | 59 | (if run-as-root 60 | (service-startup-config 61 | (inherit ssc) 62 | (root-pre-startup-scripts 63 | (append 64 | (filter-out-replaced-scripts 65 | (service-startup-config-root-pre-startup-scripts ssc)) 66 | scripts))) 67 | (service-startup-config 68 | (inherit ssc) 69 | (pre-startup-scripts 70 | (append 71 | (filter-out-replaced-scripts 72 | (service-startup-config-pre-startup-scripts ssc)) 73 | scripts))))) 74 | 75 | (define (service-extensions-modify-parameters service-extensions f) 76 | (map 77 | (lambda (se) 78 | (service-extension 79 | (service-extension-target se) 80 | (lambda (parameters) 81 | ((service-extension-compute se) 82 | (f parameters))))) 83 | service-extensions)) 84 | 85 | (define (service-type-extensions-modify-parameters type f) 86 | (service-type 87 | (inherit type) 88 | (extensions 89 | (map 90 | (lambda (se) 91 | (service-extension 92 | (service-extension-target se) 93 | (lambda (parameters) 94 | ((service-extension-compute se) 95 | (f parameters))))) 96 | (service-type-extensions type))))) 97 | 98 | (define* (run-pre-startup-scripts-gexp name pre-startup-scripts 99 | #:key home) 100 | (let 101 | ((script-gexps 102 | (map 103 | (match-lambda 104 | ((key . script) 105 | #~(lambda () 106 | (simple-format #t "Running pre-startup-script ~A\n" '#$key) 107 | 108 | (let* ((start-time (get-internal-run-time)) 109 | (result 110 | (catch 111 | #t 112 | #$script 113 | (lambda (key . args) (cons key args)))) 114 | (seconds-taken 115 | (/ (- (get-internal-run-time) start-time) 116 | internal-time-units-per-second))) 117 | (if (eq? result #t) 118 | (begin 119 | (format 120 | #t "pre-startup-script ~a succeeded (~1,2f seconds)\n" 121 | '#$key seconds-taken) 122 | #t) 123 | (begin 124 | (format 125 | #t "pre-startup-script ~a failed (~1,2f seconds)\n" 126 | '#$key seconds-taken) 127 | (format #t "result: ~A\n" result) 128 | #f)))))) 129 | pre-startup-scripts))) 130 | (if (null? script-gexps) 131 | #~#t 132 | (with-imported-modules '((gds build utils)) 133 | #~(let ((old-HOME (getenv "HOME"))) 134 | (use-modules (gds build utils) 135 | (ice-9 format)) 136 | (when #$home 137 | (setenv "HOME" #$home)) 138 | (simple-format 139 | #t 140 | "Running ~A startup scripts for ~A\n" 141 | #$(length script-gexps) 142 | '#$name) 143 | (for-each 144 | (lambda (key) (simple-format #t " - ~A\n" key)) 145 | '#$(map car pre-startup-scripts)) 146 | (let ((overall-result 147 | (let run ((scripts (list #$@script-gexps))) 148 | (if (null? scripts) 149 | #t 150 | (let ((result ((car scripts)))) 151 | (if (eq? result #t) 152 | (run (cdr scripts)) 153 | #f)))))) 154 | (when #$home 155 | (setenv "HOME" old-HOME)) 156 | overall-result)))))) 157 | 158 | (define (set-aws-xray-context-missing services value) 159 | (map 160 | (lambda (s) 161 | (service 162 | (service-kind s) 163 | (if 164 | (list? (service-parameters s)) 165 | (map 166 | (lambda (parameter) 167 | (if 168 | (service-startup-config? parameter) 169 | (service-startup-config-with-additional-environment-variables 170 | parameter 171 | `(("AWS_XRAY_CONTEXT_MISSING" . ,value))) 172 | parameter)) 173 | (service-parameters s)) 174 | (service-parameters s)))) 175 | services)) 176 | -------------------------------------------------------------------------------- /bin/govuk-aws: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | if [ ! -n "$BASH" ] ; then 4 | exec bash "$0" $@ 5 | fi 6 | 7 | set -e 8 | set -o pipefail 9 | 10 | profile="${PROFILE:-govuk-integration}" 11 | 12 | cache_directory="${XDG_CACHE_HOME-$HOME/.cache}/govuk-guix" 13 | cached_aws_credentials="$cache_directory/${profile}-aws-credentials" 14 | 15 | prompt_for_mfa_token() { 16 | prompt=$'\ngovuk-aws: Enter AWS MFA token: ' 17 | if [ ! -z "${AWS_EXPIRATION-}" ]; then 18 | prompt=$'\ngovuk-aws: Your AWS session has expired. Enter AWS MFA token: ' 19 | fi 20 | read -p "${prompt}" MFA_TOKEN 21 | } 22 | 23 | read_aws_config_file() { 24 | if [ ! -f ~/.aws/config ]; then 25 | echo "govuk: aws: ~/.aws/config doesn't exist" >&2 26 | echo "govuk: aws: please setup the relevant GOV.UK AWS configuration" >&2 27 | exit 1 28 | fi 29 | 30 | if ! grep --quiet --fixed-strings "[profile $profile]" ~/.aws/config; then 31 | echo "govuk: aws: couldn't find the '$profile' profile in ~/.aws/config" 32 | if grep --quiet "^\[profile " ~/.aws/config; then 33 | echo "govuk: aws: the following profiles are available in ~/.aws/config" 34 | sed -n -e 's/\[profile \(.*\)\]/ \1/p' ~/.aws/config 35 | else 36 | echo "govuk: aws: it doesn't look like ~/.aws/config contains any profiles" 37 | fi 38 | exit 1 39 | fi 40 | 41 | ROLE_ARN=$(awk '/profile '"$profile"'/ {profile=1} /role_arn/ && profile==1 {print $3; exit}' ~/.aws/config) 42 | MFA_SERIAL=$(awk '/profile '"$profile"'/ {profile=1} /mfa_serial/ && profile==1 {print $3; exit}' ~/.aws/config) 43 | SOURCE_PROFILE=$(awk '/profile '"$profile"'/ {profile=1} /source_profile/ && profile==1 {print $3; exit}' ~/.aws/config) 44 | } 45 | 46 | parse_aws_assume_role_output() { 47 | ACCESS_KEY_ID=$(echo ${AWS_ASSUME_ROLE_OUTPUT} | ruby -e 'require "json"; c = JSON.parse(STDIN.read)["Credentials"]; STDOUT << c["AccessKeyId"]') 48 | SECRET_ACCESS_KEY=$(echo ${AWS_ASSUME_ROLE_OUTPUT} | ruby -e 'require "json"; c = JSON.parse(STDIN.read)["Credentials"]; STDOUT << c["SecretAccessKey"]') 49 | SESSION_TOKEN=$(echo ${AWS_ASSUME_ROLE_OUTPUT} | ruby -e 'require "json"; c = JSON.parse(STDIN.read)["Credentials"]; STDOUT << c["SessionToken"]') 50 | EXPIRATION=$(echo ${AWS_ASSUME_ROLE_OUTPUT} | ruby -e 'require "json"; c = JSON.parse(STDIN.read)["Credentials"]; STDOUT << c["Expiration"]') 51 | } 52 | 53 | session_has_expired() { 54 | export EXPIRATION 55 | if [ $(ruby -r time -e 'puts (Time.parse(ENV["EXPIRATION"]) - Time.now).floor') -lt 300 ]; then 56 | return 0 57 | else 58 | return 1 59 | fi 60 | } 61 | 62 | run_aws_assume_role() { 63 | SESSION_NAME=$(whoami)-$(date +%d-%m-%y_%H-%M) 64 | read_aws_config_file 65 | 66 | if [ -z "$MFA_TOKEN" ]; then 67 | prompt_for_mfa_token 68 | fi 69 | 70 | aws_assume_role="aws sts assume-role \ 71 | --profile gds \ 72 | --role-arn $ROLE_ARN \ 73 | --role-session-name $SESSION_NAME \ 74 | --serial-number $MFA_SERIAL \ 75 | --duration-seconds 28800 \ 76 | --token-code $MFA_TOKEN" 77 | 78 | AWS_ASSUME_ROLE_OUTPUT=$(${aws_assume_role}) 79 | 80 | if [[ $? != 0 ]]; then 81 | exit "govuk-aws: aws sts assume-role: failed" 82 | fi 83 | 84 | mkdir -p "$(dirname $cached_aws_credentials)" 85 | echo $AWS_ASSUME_ROLE_OUTPUT > $cached_aws_credentials 86 | 87 | parse_aws_assume_role_output 88 | } 89 | 90 | get_aws_credentials() { 91 | if [ -f "$cached_aws_credentials" ]; then 92 | AWS_ASSUME_ROLE_OUTPUT=$(<$cached_aws_credentials) 93 | parse_aws_assume_role_output 94 | 95 | if session_has_expired; then 96 | run_aws_assume_role 97 | fi 98 | else 99 | run_aws_assume_role 100 | fi 101 | } 102 | 103 | test_aws_cli_installed() { 104 | if ! command -v aws 2>/dev/null; then 105 | echo "You need to have the aws cli tool installed to run govuk aws.\r\nIt looks like you don't.\r\nPlease visit https://aws.amazon.com/cli/ for installation instructions." 106 | exit 1 107 | fi 108 | } 109 | 110 | if [ "$1" == "--profile" ]; then 111 | profile="$2" 112 | cache_directory="${XDG_CACHE_HOME-$HOME/.cache}/govuk-guix" 113 | cached_aws_credentials="$cache_directory/${profile}-aws-credentials" 114 | 115 | test_aws_cli_installed 116 | get_aws_credentials 117 | 118 | if [ "$3" == "--export" ]; then 119 | echo "export AWS_ACCESS_KEY_ID=\"$ACCESS_KEY_ID\"" 120 | echo "export AWS_SECRET_ACCESS_KEY=\"$SECRET_ACCESS_KEY\"" 121 | echo "export AWS_SESSION_TOKEN=\"$SESSION_TOKEN\"" 122 | elif [ "$3" == "--export-json" ]; then 123 | echo "{ \"access_key_id\": \"$ACCESS_KEY_ID\", \"secret_access_key\": \"$SECRET_ACCESS_KEY\", \"session_token\": \"$SESSION_TOKEN\" }" 124 | elif [ "$3" == "--export-plain" ]; then 125 | echo 126 | echo -e " Profile\t\t $profile" 127 | echo 128 | echo -e " Session expires\t $EXPIRATION" 129 | echo 130 | echo -e " Access key id\t\t $ACCESS_KEY_ID" 131 | echo 132 | echo -e " Secret access key\t $SECRET_ACCESS_KEY" 133 | echo 134 | echo -e " Session token\t\t $SESSION_TOKEN" 135 | echo 136 | elif [ "$3" == "--export-pretty" ] || [ "$3" == "" ]; then 137 | bold="$(tput bold)" 138 | reset="$(tput sgr0)" 139 | 140 | echo 141 | echo -e " Profile\t\t $profile" 142 | echo 143 | echo -e " Session expires\t $EXPIRATION" 144 | echo 145 | echo -e " Access key id\t\t $bold$ACCESS_KEY_ID$reset" 146 | echo 147 | echo -e " Secret access key\t $bold$SECRET_ACCESS_KEY$reset" 148 | echo 149 | echo -e " Session token\t\t $bold$SESSION_TOKEN$reset" 150 | echo 151 | elif [ "$3" == "--" ]; then 152 | export AWS_ACCESS_KEY_ID="$ACCESS_KEY_ID" 153 | export AWS_SECRET_ACCESS_KEY="$SECRET_ACCESS_KEY" 154 | export AWS_SESSION_TOKEN="$SESSION_TOKEN" 155 | 156 | exec "${@:3}" 157 | else 158 | echo "govuk: aws: unknown argument '$3'" 159 | echo "govuk: aws: valid arguments are:" 160 | echo 161 | echo " --export to output the shell commands for the AWS credentials" 162 | echo " --export-plain to output the values for the AWS credentials without bold styling" 163 | echo " --export-pretty to output the values for the AWS credentials" 164 | echo " --export-json to output JSON describing the AWS credentials" 165 | echo " -- to run a command with the AWS credentials set in the environment," 166 | echo " e.g. 'govuk aws --profile=govuk-integration -- aws s3 ls'" 167 | exit 1 168 | fi 169 | elif [ "$1" == "--" ]; then 170 | exec "${@:2}" 171 | else 172 | echo "govuk: aws: unknown argument '$1'" 173 | echo "govuk: aws: valid arguments are:" 174 | echo 175 | echo " --profile followed by a profile, e.g. 'govuk aws --profile govuk-integration -- aws s3 ls'" 176 | echo " -- on it's own to not assume a role, e.g. 'govuk aws -- aws s3 ls'" 177 | exit 1 178 | fi 179 | --------------------------------------------------------------------------------