utils: Add call-with-temporary-directory.
* guix/utils.scm (call-with-temporary-directory): New procedure.
This commit is contained in:
		
							parent
							
								
									b4abdeb63b
								
							
						
					
					
						commit
						db6e5e2b2c
					
				
					 1 changed files with 15 additions and 1 deletions
				
			
		| 
						 | 
					@ -30,7 +30,7 @@
 | 
				
			||||||
  #:use-module (rnrs bytevectors)
 | 
					  #:use-module (rnrs bytevectors)
 | 
				
			||||||
  #:use-module ((rnrs io ports) #:select (put-bytevector))
 | 
					  #:use-module ((rnrs io ports) #:select (put-bytevector))
 | 
				
			||||||
  #:use-module ((guix build utils) #:select (dump-port))
 | 
					  #:use-module ((guix build utils) #:select (dump-port))
 | 
				
			||||||
  #:use-module ((guix build syscalls) #:select (errno))
 | 
					  #:use-module ((guix build syscalls) #:select (errno mkdtemp!))
 | 
				
			||||||
  #:use-module (ice-9 vlist)
 | 
					  #:use-module (ice-9 vlist)
 | 
				
			||||||
  #:use-module (ice-9 format)
 | 
					  #:use-module (ice-9 format)
 | 
				
			||||||
  #:autoload   (ice-9 popen)  (open-pipe*)
 | 
					  #:autoload   (ice-9 popen)  (open-pipe*)
 | 
				
			||||||
| 
						 | 
					@ -77,6 +77,7 @@
 | 
				
			||||||
            file-extension
 | 
					            file-extension
 | 
				
			||||||
            file-sans-extension
 | 
					            file-sans-extension
 | 
				
			||||||
            call-with-temporary-output-file
 | 
					            call-with-temporary-output-file
 | 
				
			||||||
 | 
					            call-with-temporary-directory
 | 
				
			||||||
            with-atomic-file-output
 | 
					            with-atomic-file-output
 | 
				
			||||||
            fold2
 | 
					            fold2
 | 
				
			||||||
            fold-tree
 | 
					            fold-tree
 | 
				
			||||||
| 
						 | 
					@ -652,6 +653,19 @@ call."
 | 
				
			||||||
        (false-if-exception (close out))
 | 
					        (false-if-exception (close out))
 | 
				
			||||||
        (false-if-exception (delete-file template))))))
 | 
					        (false-if-exception (delete-file template))))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					(define (call-with-temporary-directory proc)
 | 
				
			||||||
 | 
					  "Call PROC with a name of a temporary directory; close the directory and
 | 
				
			||||||
 | 
					delete it when leaving the dynamic extent of this call."
 | 
				
			||||||
 | 
					  (let* ((directory (or (getenv "TMPDIR") "/tmp"))
 | 
				
			||||||
 | 
					         (template  (string-append directory "/guix-directory.XXXXXX"))
 | 
				
			||||||
 | 
					         (tmp-dir   (mkdtemp! template)))
 | 
				
			||||||
 | 
					    (dynamic-wind
 | 
				
			||||||
 | 
					      (const #t)
 | 
				
			||||||
 | 
					      (lambda ()
 | 
				
			||||||
 | 
					        (proc tmp-dir))
 | 
				
			||||||
 | 
					      (lambda ()
 | 
				
			||||||
 | 
					        (false-if-exception (rmdir tmp-dir))))))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (with-atomic-file-output file proc)
 | 
					(define (with-atomic-file-output file proc)
 | 
				
			||||||
  "Call PROC with an output port for the file that is going to replace FILE.
 | 
					  "Call PROC with an output port for the file that is going to replace FILE.
 | 
				
			||||||
Upon success, FILE is atomically replaced by what has been written to the
 | 
					Upon success, FILE is atomically replaced by what has been written to the
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue