Rietveld Code Review Tool
Help | Bug tracker | Discussion group | Source code | Sign in
(386)

Unified Diff: scm/backend-library.scm

Issue 561810045: Prevent race condition in `-dfont-ps-resdir`
Patch Set: Improve messages Created 3 years, 10 months ago
Use n/p to move between diff chunks; N/P to move between comments. Please Sign in to add in-line comments.
Jump to:
View side-by-side diff with in-line comments
Download patch
« no previous file with comments | « no previous file | scm/framework-ps.scm » ('j') | no next file with comments »
Expand Comments ('e') | Collapse Comments ('c') | Show Comments Hide Comments ('s')
Index: scm/backend-library.scm
diff --git a/scm/backend-library.scm b/scm/backend-library.scm
index 9702ed67ebac26a14a9380c3d0dbef2a5f398562..94ab3d141bd97eaf6d445171b86ca811a6032c16 100644
--- a/scm/backend-library.scm
+++ b/scm/backend-library.scm
@@ -135,6 +135,68 @@
(ly:message (_ "Copying to `~a'...\n") ps-name)
(copy-binary-file tmp-name ps-name)))))
+(define-public (mkdir-if-not-exist path . mode)
+ (catch
+ 'system-error
+ (lambda ()
+ ;; mkdir:
+ ;; If the directory already exists, it raises system-error.
+ (if (null? mode)
+ (mkdir path)
+ (mkdir path (car mode)))
+ #t)
+ (lambda stuff
+ ;; Catch the system-error
+ (if (= EEXIST (system-error-errno stuff))
+ ;; If the directory already exists, avoid error and return #f.
+ (begin #f)
+ ;; If the cause is something else, re-throw the error.
+ (throw 'system-error (cdr stuff))))))
+
+(define-public (symlink-if-not-exist oldpath newpath)
+ (catch
+ 'system-error
+ (lambda ()
+ ;; symlink:
+ ;; If the file already exists, it raises system-error.
+ (symlink oldpath newpath)
+ #t)
+ (lambda stuff
+ ;; Catch the system-error
+ (if (= EEXIST (system-error-errno stuff))
+ ;; If the file already exists, avoid error and return #f.
+ (begin #f)
+ ;; If the cause is something else, re-throw the error.
+ (throw 'system-error (cdr stuff))))))
+
+(define-public (symlink-or-copy-if-not-exist oldpath newpath)
+ (if (eq? PLATFORM 'windows)
+ (let ((port (create-file-exclusive newpath)))
+ (if port
+ (begin
+ (close port)
+ (copy-binary-file oldpath newpath)
+ #t)
+ (begin #f)))
+ (symlink-if-not-exist oldpath newpath)))
+
+(define-public (create-file-exclusive path . mode)
+ (catch
+ 'system-error
+ (lambda ()
+ ;; Exclusive file create:
+ ;; If the file already exists, it raises system-error.
+ (if (null? mode)
+ (open path (logior O_WRONLY O_CREAT O_EXCL))
+ (open path (logior O_WRONLY O_CREAT O_EXCL) (car mode))))
+ (lambda stuff
+ ;; Catch the system-error
+ (if (= EEXIST (system-error-errno stuff))
+ ;; If the file already exists, avoid error and return #f.
+ (begin #f)
+ ;; If the cause is something else, re-throw the error.
+ (throw 'system-error (cdr stuff))))))
+
(define-public (copy-binary-file from-name to-name)
(if (eq? PLATFORM 'windows)
;; MINGW hack: MinGW Guile's copy-file is broken.
« no previous file with comments | « no previous file | scm/framework-ps.scm » ('j') | no next file with comments »

Powered by Google App Engine
RSS Feeds Recent Issues | This issue
This is Rietveld f62528b