gnu/machine/ssh.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
   3 ;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (gnu machine ssh)
  21   #:use-module (gnu bootloader)
  22   #:use-module (gnu machine)
  23   #:autoload   (gnu packages gnupg) (guile-gcrypt)
  24   #:use-module (gnu system)
  25   #:use-module (gnu system file-systems)
  26   #:use-module (gnu system uuid)
  27   #:use-module ((gnu services) #:select (sexp->system-provenance))
  28   #:use-module (guix diagnostics)
  29   #:use-module (guix memoization)
  30   #:use-module (guix gexp)
  31   #:use-module (guix i18n)
  32   #:use-module (guix modules)
  33   #:use-module (guix monads)
  34   #:use-module (guix pki)
  35   #:use-module (guix records)
  36   #:use-module (guix remote)
  37   #:use-module (guix scripts system reconfigure)
  38   #:use-module (guix ssh)
  39   #:use-module (guix store)
  40   #:use-module (guix utils)
  41   #:use-module ((guix self) #:select (make-config.scm))
  42   #:use-module ((guix inferior)
  43                 #:select (inferior-exception?
  44                           inferior-exception-arguments))
  45   #:use-module (gcrypt pk-crypto)
  46   #:use-module (ice-9 format)
  47   #:use-module (ice-9 match)
  48   #:use-module (ice-9 textual-ports)
  49   #:use-module (srfi srfi-1)
  50   #:use-module (srfi srfi-9)
  51   #:use-module (srfi srfi-19)
  52   #:use-module (srfi srfi-26)
  53   #:use-module (srfi srfi-34)
  54   #:use-module (srfi srfi-35)
  55   #:export (managed-host-environment-type
  56
  57             machine-ssh-configuration
  58             machine-ssh-configuration?
  59             machine-ssh-configuration
  60
  61             machine-ssh-configuration-host-name
  62             machine-ssh-configuration-build-locally?
  63             machine-ssh-configuration-authorize?
  64             machine-ssh-configuration-allow-downgrades?
  65             machine-ssh-configuration-port
  66             machine-ssh-configuration-user
  67             machine-ssh-configuration-host-key
  68             machine-ssh-configuration-session))
  69
  70 ;;; Commentary:
  71 ;;;
  72 ;;; This module implements remote evaluation and system deployment for
  73 ;;; machines that are accessible over SSH and have a known host-name. In the
  74 ;;; sense of the broader "machine" interface, we describe the environment for
  75 ;;; such machines as 'managed-host.
  76 ;;;
  77 ;;; Code:
  78
  79 \f
  80 ;;;
  81 ;;; Parameters for the SSH client.
  82 ;;;
  83
  84 (define-record-type* <machine-ssh-configuration> machine-ssh-configuration
  85   make-machine-ssh-configuration
  86   machine-ssh-configuration?
  87   this-machine-ssh-configuration
  88   (host-name      machine-ssh-configuration-host-name)     ; string
  89   (system         machine-ssh-configuration-system)        ; string
  90   (build-locally? machine-ssh-configuration-build-locally? ; boolean
  91                   (default #t))
  92   (authorize?     machine-ssh-configuration-authorize?     ; boolean
  93                   (default #t))
  94   (allow-downgrades? machine-ssh-configuration-allow-downgrades? ; boolean
  95                      (default #f))
  96   (safety-checks?    machine-ssh-configuration-safety-checks? ;boolean
  97                      (default #t))
  98   (port           machine-ssh-configuration-port           ; integer
  99                   (default 22))
 100   (user           machine-ssh-configuration-user           ; string
 101                   (default "root"))
 102   (identity       machine-ssh-configuration-identity       ; path to a private key
 103                   (default #f))
 104   (session        machine-ssh-configuration-session        ; session
 105                   (thunked)
 106                   (default
 107                     ;; By default, open the session once and cache it.
 108                     (open-machine-ssh-session* this-machine-ssh-configuration)))
 109   (host-key       machine-ssh-configuration-host-key       ; #f | string
 110                   (default #f)))
 111
 112 (define (open-machine-ssh-session config)
 113   "Open an SSH session for CONFIG, a <machine-ssh-configuration> record."
 114   (let ((host-name (machine-ssh-configuration-host-name config))
 115         (user (machine-ssh-configuration-user config))
 116         (port (machine-ssh-configuration-port config))
 117         (identity (machine-ssh-configuration-identity config))
 118         (host-key (machine-ssh-configuration-host-key config)))
 119     (unless host-key
 120       (warning (G_ "<machine-ssh-configuration> without a 'host-key' \
 121 is deprecated~%")))
 122     (open-ssh-session host-name
 123                       #:user user
 124                       #:port port
 125                       #:identity identity
 126                       #:host-key host-key)))
 127
 128 (define open-machine-ssh-session*
 129   (mlambdaq (config)
 130     "Memoizing variant of 'open-machine-ssh-session'."
 131     (open-machine-ssh-session config)))
 132
 133 (define (machine-ssh-session machine)
 134   "Return the SSH session that was given in MACHINE's configuration, or create
 135 one from the configuration's parameters if one was not provided."
 136   (maybe-raise-unsupported-configuration-error machine)
 137   (let ((config (machine-configuration machine)))
 138     (or (machine-ssh-configuration-session config)
 139         (open-machine-ssh-session config))))
 140
 141 \f
 142 ;;;
 143 ;;; Remote evaluation.
 144 ;;;
 145
 146 (define (machine-become-command machine)
 147   "Return as a list of strings the program and arguments necessary to run a
 148 shell command with escalated privileges for MACHINE's configuration."
 149   (if (string= "root" (machine-ssh-configuration-user
 150                        (machine-configuration machine)))
 151       '()
 152       '("/run/setuid-programs/sudo" "-n" "--")))
 153
 154 (define (managed-host-remote-eval machine exp)
 155   "Internal implementation of 'machine-remote-eval' for MACHINE instances with
 156 an environment type of 'managed-host."
 157   (maybe-raise-unsupported-configuration-error machine)
 158   (let ((config (machine-configuration machine)))
 159     (remote-eval exp (machine-ssh-session machine)
 160                  #:build-locally?
 161                  (machine-ssh-configuration-build-locally? config)
 162                  #:system
 163                  (machine-ssh-configuration-system config)
 164                  #:become-command
 165                  (machine-become-command machine))))
 166
 167 \f
 168 ;;;
 169 ;;; Safety checks.
 170 ;;;
 171
 172 ;; Assertion to be executed remotely.  This abstraction exists to allow us to
 173 ;; gather a list of expressions to be evaluated and eventually evaluate them
 174 ;; all at once instead of one by one.  (This is pretty much a monad.)
 175 (define-record-type <remote-assertion>
 176   (remote-assertion exp proc)
 177   remote-assertion?
 178   (exp   remote-assertion-expression)
 179   (proc  remote-assertion-procedure))
 180
 181 (define-syntax-rule (remote-let ((var exp)) body ...)
 182   "Return a <remote-assertion> that binds VAR to the result of evaluating EXP,
 183 a gexp, remotely, and evaluate BODY in that context."
 184   (remote-assertion exp (lambda (var) body ...)))
 185
 186 (define (machine-check-file-system-availability machine)
 187   "Return a list of <remote-assertion> that raise a '&message' error condition
 188 if any of the file-systems specified in MACHINE's 'system' declaration do not
 189 exist on the machine."
 190   (define file-systems
 191     (filter (lambda (fs)
 192               (and (file-system-mount? fs)
 193                    (not (member (file-system-type fs)
 194                                 %pseudo-file-system-types))
 195                    ;; Don't try to validate network file systems.
 196                    (not (string-prefix? "nfs" (file-system-type fs)))
 197                    (not (memq 'bind-mount (file-system-flags fs)))))
 198             (operating-system-file-systems (machine-operating-system machine))))
 199
 200   (define (check-literal-file-system fs)
 201     (remote-let ((errno #~(catch 'system-error
 202                             (lambda ()
 203                               (stat #$(file-system-device fs))
 204                               #t)
 205                             (lambda args
 206                               (system-error-errno args)))))
 207       (when (number? errno)
 208         (raise (formatted-message (G_ "device '~a' not found: ~a")
 209                                   (file-system-device fs)
 210                                   (strerror errno))))))
 211
 212   (define (check-labeled-file-system fs)
 213     (define remote-exp
 214       (with-imported-modules (source-module-closure
 215                               '((gnu build file-systems)))
 216         #~(begin
 217             (use-modules (gnu build file-systems))
 218             (find-partition-by-label #$(file-system-label->string
 219                                         (file-system-device fs))))))
 220
 221     (remote-let ((result remote-exp))
 222       (unless result
 223         (raise (formatted-message (G_ "no file system with label '~a'")
 224                                   (file-system-label->string
 225                                    (file-system-device fs)))))))
 226
 227   (define (check-uuid-file-system fs)
 228     (define remote-exp
 229       (with-imported-modules (source-module-closure
 230                               '((gnu build file-systems)
 231                                 (gnu system uuid)))
 232         #~(begin
 233             (use-modules (gnu build file-systems)
 234                          (gnu system uuid))
 235
 236             (let ((uuid (uuid #$(uuid->string (file-system-device fs))
 237                               '#$(uuid-type (file-system-device fs)))))
 238               (find-partition-by-uuid uuid)))))
 239
 240     (remote-let ((result remote-exp))
 241       (unless result
 242         (raise (formatted-message (G_ "no file system with UUID '~a'")
 243                                   (uuid->string (file-system-device fs)))))))
 244
 245   (if (machine-ssh-configuration-safety-checks?
 246        (machine-configuration machine))
 247       (append (map check-literal-file-system
 248                    (filter (lambda (fs)
 249                              (string? (file-system-device fs)))
 250                            file-systems))
 251               (map check-labeled-file-system
 252                    (filter (lambda (fs)
 253                              (file-system-label? (file-system-device fs)))
 254                            file-systems))
 255               (map check-uuid-file-system
 256                    (filter (lambda (fs)
 257                              (uuid? (file-system-device fs)))
 258                            file-systems)))
 259       '()))
 260
 261 (define (machine-check-initrd-modules machine)
 262   "Return a list of <remote-assertion> that raise a '&message' error condition
 263 if any of the modules needed by 'needed-for-boot' file systems in MACHINE are
 264 not available in the initrd."
 265   (define file-systems
 266     (filter file-system-needed-for-boot?
 267             (operating-system-file-systems (machine-operating-system machine))))
 268
 269   (define (missing-modules fs)
 270     (define remote-exp
 271       (let ((device (file-system-device fs)))
 272         (with-imported-modules (source-module-closure
 273                                 '((gnu build file-systems)
 274                                   (gnu build linux-modules)
 275                                   (gnu system uuid)))
 276           #~(begin
 277               (use-modules (gnu build file-systems)
 278                            (gnu build linux-modules)
 279                            (gnu system uuid))
 280
 281               (define dev
 282                 #$(cond ((string? device) device)
 283                         ((uuid? device) #~(find-partition-by-uuid
 284                                            (string->uuid
 285                                             #$(uuid->string device))))
 286                         ((file-system-label? device)
 287                          #~(find-partition-by-label
 288                             #$(file-system-label->string device)))))
 289
 290               (missing-modules dev '#$(operating-system-initrd-modules
 291                                        (machine-operating-system machine)))))))
 292
 293     (remote-let ((missing remote-exp))
 294       (unless (null? missing)
 295         (raise (formatted-message (G_ "missing modules for ~a:~{ ~a~}~%")
 296                                   (file-system-device fs)
 297                                   missing)))))
 298
 299   (if (machine-ssh-configuration-safety-checks?
 300        (machine-configuration machine))
 301       (map missing-modules file-systems)
 302       '()))
 303
 304 (define* (machine-check-forward-update machine)
 305   "Check whether we are making a forward update for MACHINE.  Depending on its
 306 'allow-upgrades?' field, raise an error or display a warning if we are
 307 potentially downgrading it."
 308   (define config
 309     (machine-configuration machine))
 310
 311   (define validate-reconfigure
 312     (if (machine-ssh-configuration-allow-downgrades? config)
 313         warn-about-backward-reconfigure
 314         ensure-forward-reconfigure))
 315
 316   (remote-let ((provenance #~(call-with-input-file
 317                                  "/run/current-system/provenance"
 318                                read)))
 319     (define channels
 320       (sexp->system-provenance provenance))
 321
 322     (check-forward-update validate-reconfigure
 323                           #:current-channels channels)))
 324
 325 (define (machine-check-building-for-appropriate-system machine)
 326   "Raise a '&message' error condition if MACHINE is configured to be built
 327 locally and the 'system' field does not match the '%current-system' reported
 328 by MACHINE."
 329   (let ((config (machine-configuration machine))
 330         (system (remote-system (machine-ssh-session machine))))
 331     (when (and (machine-ssh-configuration-build-locally? config)
 332                (not (string= system (machine-ssh-configuration-system config))))
 333       (raise (formatted-message (G_ "incorrect target system\
 334  ('~a' was given, while the system reports that it is '~a')~%")
 335                                 (machine-ssh-configuration-system config)
 336                                 system)))))
 337
 338 (define (check-deployment-sanity machine)
 339   "Raise a '&message' error condition if it is clear that deploying MACHINE's
 340 'system' declaration would fail."
 341   (define assertions
 342     (parameterize ((%current-system
 343                     (machine-ssh-configuration-system
 344                      (machine-configuration machine)))
 345                    (%current-target-system #f))
 346       (append (machine-check-file-system-availability machine)
 347               (machine-check-initrd-modules machine)
 348               (list (machine-check-forward-update machine)))))
 349
 350   (define aggregate-exp
 351     ;; Gather all the expressions so that a single round-trip is enough to
 352     ;; evaluate all the ASSERTIONS remotely.
 353     #~(map (lambda (file)
 354              (false-if-exception (primitive-load file)))
 355            '#$(map (lambda (assertion)
 356                      (scheme-file "remote-assertion.scm"
 357                                   (remote-assertion-expression assertion)))
 358                    assertions)))
 359
 360   ;; First check MACHINE's system type--an incorrect value for 'system' would
 361   ;; cause subsequent invocations of 'remote-eval' to fail.
 362   (machine-check-building-for-appropriate-system machine)
 363
 364   (mlet %store-monad ((values (machine-remote-eval machine aggregate-exp)))
 365     (for-each (lambda (proc value)
 366                 (proc value))
 367               (map remote-assertion-procedure assertions)
 368               values)
 369     (return #t)))
 370
 371 \f
 372 ;;;
 373 ;;; System deployment.
 374 ;;;
 375
 376 (define not-config?
 377   ;; Select (guix …) and (gnu …) modules, except (guix config).
 378   (match-lambda
 379     (('guix 'config) #f)
 380     (('guix _ ...) #t)
 381     (('gnu _ ...) #t)
 382     (_ #f)))
 383
 384 (define (machine-boot-parameters machine)
 385   "Monadic procedure returning a list of 'boot-parameters' for the generations
 386 of MACHINE's system profile, ordered from most recent to oldest."
 387   (define bootable-kernel-arguments
 388     (@@ (gnu system) bootable-kernel-arguments))
 389
 390   (define remote-exp
 391     (with-extensions (list guile-gcrypt)
 392       (with-imported-modules `(((guix config) => ,(make-config.scm))
 393                                ,@(source-module-closure
 394                                   '((guix profiles))
 395                                   #:select? not-config?))
 396         #~(begin
 397             (use-modules (guix config)
 398                          (guix profiles)
 399                          (ice-9 textual-ports))
 400
 401             (define %system-profile
 402               (string-append %state-directory "/profiles/system"))
 403
 404             (define (read-file path)
 405               (call-with-input-file path
 406                 (lambda (port)
 407                   (get-string-all port))))
 408
 409             (map (lambda (generation)
 410                    (let* ((system-path (generation-file-name %system-profile
 411                                                              generation))
 412                           (boot-parameters-path (string-append system-path
 413                                                                "/parameters"))
 414                           (time (stat:mtime (lstat system-path))))
 415                      (list generation
 416                            system-path
 417                            time
 418                            (read-file boot-parameters-path))))
 419                  (reverse (generation-numbers %system-profile)))))))
 420
 421   (mlet* %store-monad ((generations (machine-remote-eval machine remote-exp)))
 422     (return
 423      (map (lambda (generation)
 424             (match generation
 425               ((generation system-path time serialized-params)
 426                (let* ((params (call-with-input-string serialized-params
 427                                 read-boot-parameters))
 428                       (root (boot-parameters-root-device params))
 429                       (label (boot-parameters-label params))
 430                       (version (boot-parameters-version params)))
 431                  (boot-parameters
 432                   (inherit params)
 433                   (label
 434                    (string-append label " (#"
 435                                   (number->string generation) ", "
 436                                   (let ((time (make-time time-utc 0 time)))
 437                                     (date->string (time-utc->date time)
 438                                                   "~Y-~m-~d ~H:~M"))
 439                                   ")"))
 440                   (kernel-arguments
 441                    (append (bootable-kernel-arguments system-path root version)
 442                            (boot-parameters-kernel-arguments params))))))))
 443           generations))))
 444
 445 (define-syntax-rule (with-roll-back should-roll-back? mbody ...)
 446   "Catch exceptions that arise when binding MBODY, a monadic expression in
 447 %STORE-MONAD, and collect their arguments in a &deploy-error condition, with
 448 the 'should-roll-back' field set to SHOULD-ROLL-BACK?"
 449   (catch #t
 450     (lambda ()
 451       mbody ...)
 452     (lambda args
 453       (raise (condition (&deploy-error
 454                          (should-roll-back should-roll-back?)
 455                          (captured-args args)))))))
 456
 457 (define (deploy-managed-host machine)
 458   "Internal implementation of 'deploy-machine' for MACHINE instances with an
 459 environment type of 'managed-host."
 460   (define config (machine-configuration machine))
 461   (define host   (machine-ssh-configuration-host-name config))
 462   (define system (machine-ssh-configuration-system config))
 463
 464   (maybe-raise-unsupported-configuration-error machine)
 465   (when (machine-ssh-configuration-authorize?
 466          (machine-configuration machine))
 467     (unless (file-exists? %public-key-file)
 468       (raise (formatted-message (G_ "no signing key '~a'. \
 469 have you run 'guix archive --generate-key?'")
 470                                 %public-key-file)))
 471     (remote-authorize-signing-key (call-with-input-file %public-key-file
 472                                     (lambda (port)
 473                                       (string->canonical-sexp
 474                                        (get-string-all port))))
 475                                   (machine-ssh-session machine)
 476                                   (machine-become-command machine)))
 477
 478   (mlet %store-monad ((_ (check-deployment-sanity machine))
 479                       (boot-parameters (machine-boot-parameters machine)))
 480     ;; Make sure code that check %CURRENT-SYSTEM, such as
 481     ;; %BASE-INITRD-MODULES, gets to see the right value.
 482     (parameterize ((%current-system system)
 483                    (%current-target-system #f))
 484       (let* ((os (machine-operating-system machine))
 485              (eval (cut machine-remote-eval machine <>))
 486              (menu-entries (map boot-parameters->menu-entry boot-parameters))
 487              (bootloader-configuration (operating-system-bootloader os))
 488              (bootcfg (operating-system-bootcfg os menu-entries)))
 489         (define-syntax-rule (eval/error-handling condition handler ...)
 490           ;; Return a wrapper around EVAL such that HANDLER is evaluated if an
 491           ;; exception is raised.
 492           (lambda (exp)
 493             (lambda (store)
 494               (guard (condition ((inferior-exception? condition)
 495                                  (values (begin handler ...) store)))
 496                 (values (run-with-store store (eval exp)
 497                                         #:system system)
 498                         store)))))
 499
 500         (mbegin %store-monad
 501           (with-roll-back #f
 502             (switch-to-system (eval/error-handling c
 503                                 (raise (formatted-message
 504                                         (G_ "\
 505 failed to switch systems while deploying '~a':~%~{~s ~}")
 506                                         host
 507                                         (inferior-exception-arguments c))))
 508                               os))
 509           (with-roll-back #t
 510             (mbegin %store-monad
 511               (upgrade-shepherd-services (eval/error-handling c
 512                                            (warning (G_ "\
 513 an error occurred while upgrading services on '~a':~%~{~s ~}~%")
 514                                                     host
 515                                                     (inferior-exception-arguments
 516                                                      c)))
 517                                          os)
 518               (install-bootloader (eval/error-handling c
 519                                     (raise (formatted-message
 520                                             (G_ "\
 521 failed to install bootloader on '~a':~%~{~s ~}~%")
 522                                             host
 523                                             (inferior-exception-arguments c))))
 524                                   bootloader-configuration bootcfg))))))))
 525
 526 \f
 527 ;;;
 528 ;;; Roll-back.
 529 ;;;
 530
 531 (define (roll-back-managed-host machine)
 532   "Internal implementation of 'roll-back-machine' for MACHINE instances with
 533 an environment type of 'managed-host."
 534   (define remote-exp
 535     (with-extensions (list guile-gcrypt)
 536       (with-imported-modules (source-module-closure '((guix config)
 537                                                       (guix profiles)))
 538         #~(begin
 539             (use-modules (guix config)
 540                          (guix profiles))
 541
 542             (define %system-profile
 543               (string-append %state-directory "/profiles/system"))
 544
 545             (define target-generation
 546               (relative-generation %system-profile -1))
 547
 548             (if target-generation
 549                 (switch-to-generation %system-profile target-generation)
 550                 'error)))))
 551
 552   (define roll-back-failure
 553     (condition (&message (message (G_ "could not roll-back machine")))))
 554
 555   (mlet* %store-monad ((boot-parameters (machine-boot-parameters machine))
 556                        (_ -> (if (< (length boot-parameters) 2)
 557                                  (raise roll-back-failure)))
 558                        (entries -> (map boot-parameters->menu-entry
 559                                         (list (second boot-parameters))))
 560                        (locale -> (boot-parameters-locale
 561                                    (second boot-parameters)))
 562                        (crypto-dev -> (boot-parameters-store-crypto-devices
 563                                        (second boot-parameters)))
 564                        (store-dir -> (boot-parameters-store-directory-prefix
 565                                       (second boot-parameters)))
 566                        (old-entries -> (map boot-parameters->menu-entry
 567                                             (drop boot-parameters 2)))
 568                        (bootloader -> (operating-system-bootloader
 569                                        (machine-operating-system machine)))
 570                        (bootcfg (lower-object
 571                                  ((bootloader-configuration-file-generator
 572                                    (bootloader-configuration-bootloader
 573                                     bootloader))
 574                                   bootloader entries
 575                                   #:locale locale
 576                                   #:store-crypto-devices crypto-dev
 577                                   #:store-directory-prefix store-dir
 578                                   #:old-entries old-entries)))
 579                        (remote-result (machine-remote-eval machine remote-exp)))
 580     (when (eqv? 'error remote-result)
 581       (raise roll-back-failure))))
 582
 583 \f
 584 ;;;
 585 ;;; Environment type.
 586 ;;;
 587
 588 (define managed-host-environment-type
 589   (environment-type
 590    (machine-remote-eval managed-host-remote-eval)
 591    (deploy-machine      deploy-managed-host)
 592    (roll-back-machine   roll-back-managed-host)
 593    (name                'managed-host-environment-type)
 594    (description         "Provisioning for machines that are accessible over SSH
 595 and have a known host-name. This entails little more than maintaining an SSH
 596 connection to the host.")))
 597
 598 (define (maybe-raise-unsupported-configuration-error machine)
 599   "Raise an error if MACHINE's configuration is not an instance of
 600 <machine-ssh-configuration>."
 601   (let ((config (machine-configuration machine))
 602         (environment (environment-type-name (machine-environment machine))))
 603     (unless (and config (machine-ssh-configuration? config))
 604       (raise (formatted-message (G_ "unsupported machine configuration '~a'
 605 for environment of type '~a'")
 606                                 config
 607                                 environment)))))
 608
 609 ;; Local Variables:
 610 ;; eval: (put 'remote-let 'scheme-indent-function 1)
 611 ;; eval: (put 'with-roll-back 'scheme-indent-function 1)
 612 ;; eval: (put 'eval/error-handling 'scheme-indent-function 1)
 613 ;; End: