#+sbcl sb-ext:*posix-argv*
)
-(defun shell-command-output (cmd &key directory whole)
- #+allegro (excl.osi:command-output cmd :directory directory :whole whole)
- #+sbcl
- (let* ((out (make-array '(0) :element-type 'base-char :fill-pointer 0
- :adjustable t))
- (err (make-array '(0) :element-type 'base-char :fill-pointer 0
- :adjustable t))
- (status
- (sb-impl::process-exit-code
- (with-output-to-string (out-stream out)
- (with-output-to-string (err-stream err)
- (sb-ext:run-program
- "/bin/sh"
- (list "-c" cmd)
- :input nil :output out-stream :error err-stream))))))
- (values out err status))
- )
+(defun copy-file (from to &key link overwrite preserve-symbolic-links
+ (preserve-time t) remove-destination force verbose)
+ #+allegro (sys:copy-file from to :link link :overwrite overwrite
+ :preserve-symbolic-links preserve-symbolic-links
+ :preserve-time preserve-time
+ :remove-destination remove-destination
+ :force force :verbose verbose)
+ #-allegro
+ (cond
+ ((and (typep from 'stream) (typep to 'stream))
+ (copy-binary-stream from to))
+ ((not (probe-file from))
+ (error "File ~A does not exist." from))
+ ((eq link :hard)
+ (run-shell-command "ln -f ~A ~A" (namestring from) (namestring to)))
+ (link
+ (multiple-value-bind (stdout stderr status)
+ (command-output "ln -f ~A ~A" (namestring from) (namestring to))
+ (declare (ignore stdout stderr))
+ ;; try symbolic if command failed
+ (unless (zerop status)
+ (run-shell-command "ln -sf ~A ~A" (namestring from) (namestring to)))))
+ (t
+ (when (and (or force remove-destination) (probe-file to))
+ (delete-file to))
+ (let* ((options (if preserve-time
+ "-p"
+ ""))
+ (cmd (format nil "cp ~A ~A ~A" options (namestring from) (namestring to))))
+ (run-shell-command cmd)))))
(write-char #\: stream)
(write-string (aref +datetime-number-strings+ minute) stream)))
+(defun copy-binary-stream (in out)
+ (do* ((buf (make-array 4096 :element-type '(unsigned-byte 8)))
+ (pos (read-sequence buf in) (read-sequence buf in)))
+ ((zerop pos))
+ (write-sequence buf out :end pos)))
(:file "processes" :depends-on ("macros"))
(:file "listener" :depends-on ("sockets" "processes" "console"))
(:file "repl" :depends-on ("listener" "strings"))
- (:file "os" :depends-on ("macros"))
+ (:file "os" :depends-on ("macros" "impl"))
))
(defmethod perform ((o test-op) (c (eql (find-system 'kmrcl))))
(let ((status
(system:call-system-showing-output
command
- :shell-type "/bin/sh"
+ :prefix ""
+ :show-cmd nil
:output-stream output)))
(values (get-output-stream-string output) nil status))
(close output)))
(system:call-system-showing-output
command
:shell-type "/bin/sh"
- :output-stream output)
+ :show-cmd nil
+ :prefix ""
+ :output-stream nil)
#+clisp ;XXX not exactly *verbose-out*, I know
(ext:run-shell-command command :output :terminal :wait t)
(command-output cmd)))
((eq if-does-not-exist :error)
(error "Directory ~A does not exist [delete-directory-and-files]." dir))))
+
+(defun file-size (file)
+ #+allegro (let ((stat (excl.osi:stat (namestring file))))
+ (excl.osi:stat-size stat))
+ #-allegro
+ (with-open-file (in file :direction :input)
+ (file-length in)))