raco exe: checks on source and destination paths

Disallow creating a launcher whose source is the launcher itself,
for example.

original commit: 2fcb635790
This commit is contained in:
Matthew Flatt 2012-05-28 20:30:58 -06:00
parent 767cae7e20
commit fd364dc2de

View File

@ -1,5 +1,5 @@
#lang scheme/base #lang racket/base
(require scheme/cmdline (require racket/cmdline
raco/command-name raco/command-name
compiler/private/embed compiler/private/embed
launcher/launcher launcher/launcher
@ -73,6 +73,23 @@
(extract-base-filename/ss source-file (extract-base-filename/ss source-file
(string->symbol (short-program+command-name)))) (string->symbol (short-program+command-name))))
(gui))]) (gui))])
(unless (file-exists? source-file)
(raise-user-error (string->symbol (short-program+command-name))
"source file does not exist\n path: ~a" source-file))
(with-handlers ([exn:fail:filesystem? (lambda (exn) (void))])
(call-with-input-file* dest
(lambda (dest-in)
(call-with-input-file* source-file
(lambda (source-in)
(when (equal? (port-file-identity dest-in)
(port-file-identity source-in))
(raise-user-error (string->symbol (short-program+command-name))
(string-append
"source file is the same as the destination file"
"\n source path: ~a"
"\n destination path: ~a")
source-file
dest)))))))
(cond (cond
[(launcher) [(launcher)
(parameterize ([current-launcher-variant (if (3m) '3m 'cgc)]) (parameterize ([current-launcher-variant (if (3m) '3m 'cgc)])