123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338 |
- #!/usr/bin/env -S guile --no-auto-compile -e main -s
- !#
- (use-modules (json)
- (srfi srfi-1)
- (srfi srfi-37)
- (guix scripts)
- (guix tests))
- (define %options
- (list
- (option '(#\d "dry-run") #f #f
- (lambda (opt name arg result)
- (values (alist-cons 'dry-run? #t result)
- #f)))
- (option '(#\N "host-network") #f #f
- (lambda (opt name arg result)
- (values (alist-cons 'host-network? #t result)
- #f)))
- (option '(#\n "namespace") #t #f
- (lambda (opt name arg result)
- (alist-cons 'namespace arg result)))
- (option '(#\H "host") #t #f
- (lambda (opt name arg result)
- (alist-cons 'host arg result)))
- (option '(#\f "format") #t #f
- (lambda (opt name arg result)
- (alist-cons 'format arg result)))
- (option '(#\u "uid") #t #f
- (lambda (opt name arg result)
- (alist-cons 'uid arg result)))
- (option '(#\g "gid") #t #f
- (lambda (opt name arg result)
- (alist-cons 'gid arg result)))
- (option '(#\m "machinectl") #t #f
- (lambda (opt name arg result)
- (alist-cons 'machinectl arg result)))
- (option '(#\s "sudo") #t #f
- (lambda (opt name arg result)
- (alist-cons 'sudo arg result)))
- (option '(#\C "cpu") #t #f
- (lambda (opt name arg result)
- (alist-cons 'cpu arg result)))
- (option '(#\M "memory") #t #f
- (lambda (opt name arg result)
- (alist-cons 'memory arg result)))
- (option '(#\i "image") #t #f
- (lambda (opt name arg result)
- (alist-cons 'image arg result)))
- (option '(#\S "spec") #t #f
- (lambda (opt name arg result)
- (alist-cons 'spec arg result)))))
- (define %default-options
- '(()))
- (define (random-string)
- (number->string (random (expt 2 30) (%seed)) 16))
- (define %tolerations
- #((("effect" . "NoSchedule")
- ("value" . "true")
- ("operator" . "Equal")
- ("key" . "unschedulable"))
- (("operator" . "Exists"))
- (("operator" . "Exists")
- ("key" . "node.kubernetes.io/not-ready")
- ("effect" . "NoExecute"))
- (("operator" . "Exists")
- ("key" . "node.kubernetes.io/unreachable")
- ("effect" . "NoExecute"))
- (("operator" . "Exists")
- ("key" . "node.kubernetes.io/disk-pressure")
- ("effect" . "NoSchedule"))
- (("operator" . "Exists")
- ("key" . "node.kubernetes.io/memory-pressure")
- ("effect" . "NoSchedule"))
- (("operator" . "Exists")
- ("key" . "node.kubernetes.io/pid-pressure")
- ("effect" . "NoSchedule"))
- (("operator" . "Exists")
- ("key" . "node.kubernetes.io/unschedulable")
- ("effect" . "NoSchedule"))
- (("operator" . "Exists")
- ("key" . "node.kubernetes.io/network-unavailable")
- ("effect" . "NoSchedule"))))
- (define (main args)
- (define opts
- (parse-command-line args %options
- (list %default-options)))
- (define dry-run? (assoc-ref opts 'dry-run?))
- (define host-network? (assoc-ref opts 'host-network?))
- (define namespace (assoc-ref opts 'namespace))
- (define host (assoc-ref opts 'host))
- (define format
- (or (assoc-ref opts 'format)
- "busybox"))
- (define uid (assoc-ref opts 'uid))
- (define gid (assoc-ref opts 'gid))
- (define machinectl (assoc-ref opts 'machinectl))
- (define sudo (assoc-ref opts 'sudo))
- (define cpu (assoc-ref opts 'cpu))
- (define memory (assoc-ref opts 'memory))
- (define image (assoc-ref opts 'image))
- (define spec
- (let ((spec (assoc-ref opts 'spec)))
- (if spec
- (json-string->scm spec)
- '())))
- (case (string->symbol format)
- ((busybox)
- (let ((labels '(("app.kubernetes.io/name" . "busybox"))))
- (apply system*
- `(,@(if dry-run? '("echo") '())
- "kubectl"
- "run"
- "--rm=true"
- "--stdin=true"
- "--tty=true"
- ,@(if namespace
- (list (string-append "--namespace=" namespace))
- '())
- ,(string-append "--labels="
- (string-join
- (map (lambda (label)
- (string-append (first label)
- "="
- (cdr label)))
- labels)
- ","))
- ,@(if host
- (list
- (string-concatenate
- (list
- "--overrides="
- (scm->json-string
- `(("spec"
- ("hostNetwork" . ,host-network?)
- ("tolerations" . ,%tolerations)
- ("nodeSelector"
- ("kubernetes.io/hostname" . ,host)))
- ("apiVersion" . "v1"))))))
- '())
- ,(string-append "busybox-" (random-string))
- "--image=busybox"
- "/bin/sh"))))
- ((nixery)
- (let ((labels '(("app.kubernetes.io/name" . "nixery"))))
- (apply system*
- `(,@(if dry-run? '("echo") '())
- "kubectl"
- "run"
- "--rm=true"
- "--stdin=true"
- "--tty=true"
- ,@(if namespace
- (list (string-append "--namespace=" namespace))
- '())
- ,(string-append "--labels="
- (string-join
- (map (lambda (label)
- (string-append (first label)
- "="
- (cdr label)))
- labels)
- ","))
- ,@(if host
- (list
- (string-concatenate
- (list
- "--overrides="
- (scm->json-string
- `(("spec"
- ("hostNetwork" . ,host-network?)
- ("tolerations" . ,%tolerations)
- ("nodeSelector"
- ("kubernetes.io/hostname" . ,host))
- ,@spec)
- ("apiVersion" . "v1"))))))
- '())
- ,(string-append "nixery-" (random-string))
- ,(string-append "--image=" (if image image "nixery.dev/shell/coreutils/util-linux/iptables/iproute2/netcat-openbsd/tcpdump/mtr"))
- "/bin/bash"))))
- ((netshoot)
- (let ((labels '(("app.kubernetes.io/name" . "netshoot"))))
- (apply system*
- `(,@(if dry-run? '("echo") '())
- "kubectl"
- "run"
- "--rm=true"
- "--stdin=true"
- "--tty=true"
- ,@(if namespace
- (list (string-append "--namespace=" namespace))
- '())
- ,(string-append "--labels="
- (string-join
- (map (lambda (label)
- (string-append (first label)
- "="
- (cdr label)))
- labels)
- ","))
- ,@(if host
- (list
- (string-concatenate
- (list
- "--overrides="
- (scm->json-string
- `(("spec"
- ("tolerations" . ,%tolerations)
- ("nodeSelector"
- ("kubernetes.io/hostname" . ,host)))
- ("apiVersion" . "v1"))))))
- '())
- ,(string-append "netshoot-" (random-string))
- "--image=nicolaka/netshoot"
- "/bin/bash"))))
- ((nanoserver)
- (let ((labels '(("app.kubernetes.io/name" . "nanoserver"))))
- (apply system*
- `(,@(if dry-run? '("echo") '())
- "kubectl"
- "run"
- "--rm=true"
- "--stdin=true"
- "--tty=true"
- ,@(if namespace
- (list (string-append "--namespace=" namespace))
- '())
- ,(string-append "--labels="
- (string-join
- (map (lambda (label)
- (string-append (first label)
- "="
- (cdr label)))
- labels)
- ","))
- ,@(if host
- (list
- (string-concatenate
- (list
- "--overrides="
- (scm->json-string
- `(("spec"
- ("tolerations" . ,%tolerations)
- ("nodeSelector"
- ("kubernetes.io/hostname" . ,host)))
- ("apiVersion" . "v1"))))))
- '())
- ,(string-append "nanoserver-" (random-string))
- "--image=mcr.microsoft.com/windows/nanoserver:ltsc2022"))))
- ((shell)
- (let ((labels '(("app.kubernetes.io/name" . "nsenter"))))
- (apply system*
- `(,@(if dry-run? '("echo") '())
- "kubectl"
- "run"
- "--rm=true"
- "--stdin=true"
- "--tty=true"
- ,@(if namespace
- (list (string-append "--namespace=" namespace))
- '())
- ,(string-append "--labels="
- (string-join
- (map (lambda (label)
- (string-append (first label)
- "="
- (cdr label)))
- labels)
- ","))
- ,@(if host
- (list
- (string-concatenate
- (list
- "--overrides="
- (scm->json-string
- `(("spec"
- ("tolerations" . ,%tolerations)
- ("containers"
- .
- #((("resources"
- ("requests"
- ,@(if memory
- (list (cons "memory" memory))
- (list (cons "memory" "256Mi")))
- ,@(if cpu
- (list (cons "cpu" cpu))
- (list (cons "cpu" "100m"))))
- ("limits"
- ,@(if memory
- (list (cons "memory" memory))
- (list (cons "memory" "256Mi")))
- ,@(if cpu
- (list (cons "cpu" cpu))
- (list (cons "cpu" "100m")))))
- ("command"
- .
- #("nsenter"
- "--target"
- "1"
- "--mount"
- "--uts"
- "--ipc"
- "--net"
- "--pid"
- "--no-fork"
- ,@(if uid
- (list "-S" uid)
- '())
- ,@(if gid
- (list "-G" gid)
- '())
- ,@(cond
- (machinectl
- (list "sh" "-l" "-c"
- (string-join (list "machinectl" "shell"
- (string-append machinectl "@")))))
- (sudo
- (list "sh" "-l" "-c"
- (string-join (list "sudo" "-u" sudo "-i"))))
- (else
- '("/bin/sh" "-l")))))
- ("tty" . #t)
- ("stdinOnce" . #t)
- ("stdin" . #t)
- ("name" . "nsenter")
- ("image" . "docker.io/library/alpine")
- ("securityContext" ("privileged" . #t)))))
- ("hostNetwork" . #t)
- ("hostPID" . #t)
- ("nodeName" . ,host)))))))
- '())
- "--image=docker.io/library/alpine"
- ,(string-append "shell-" (random-string))))))))
|