| ... |
... |
@@ -2914,27 +2914,30 @@ |
|
2914
|
2914
|
*filename-encoding*))
|
|
2915
|
2915
|
;; Convert the string to octets using the
|
|
2916
|
2916
|
;; *FILENAME-ENCODING*. Should we signal an error if the
|
|
2917
|
|
- ;; string can be encoded?
|
|
|
2917
|
+ ;; string can't be encoded?
|
|
2918
|
2918
|
(octets (stream:string-to-octets template
|
|
2919
|
2919
|
:external-format format))
|
|
2920
|
|
- (length (length octets))
|
|
2921
|
|
- (buffer (make-array (1+ length)
|
|
2922
|
|
- :element-type '(unsigned-byte 8)
|
|
2923
|
|
- :initial-element 0)))
|
|
2924
|
|
- ;; Copy the octets from OCTETS to the null-terminated array BUFFER.
|
|
2925
|
|
- (replace buffer octets)
|
|
2926
|
|
- (syscall ("mkstemp" (* c-call:char))
|
|
2927
|
|
- (values result
|
|
2928
|
|
- ;; Convert the array of octets in BUFFER back to
|
|
2929
|
|
- ;; a Lisp string.
|
|
2930
|
|
- (stream:octets-to-string buffer
|
|
2931
|
|
- :end length
|
|
2932
|
|
- :external-format format))
|
|
2933
|
|
- (sys:vector-sap buffer))))
|
|
|
2920
|
+ (length (length octets)))
|
|
|
2921
|
+ (with-alien ((buffer (* c-call:unsigned-char)))
|
|
|
2922
|
+ (setf buffer (make-alien c-call:unsigned-char (1+ length)))
|
|
|
2923
|
+ ;; Copy the octets from OCTETS to the null-terminated array BUFFER.
|
|
|
2924
|
+ (dotimes (k length)
|
|
|
2925
|
+ (setf (deref buffer k) (aref octets k)))
|
|
|
2926
|
+ (setf (deref buffer length) 0)
|
|
|
2927
|
+
|
|
|
2928
|
+ (syscall ("mkstemp" (* c-call:char))
|
|
|
2929
|
+ (values result
|
|
|
2930
|
+ (progn
|
|
|
2931
|
+ ;; Copy out the alien bytes and convert back
|
|
|
2932
|
+ ;; to a lisp string.
|
|
|
2933
|
+ (dotimes (k length)
|
|
|
2934
|
+ (setf (aref octets k) (deref buffer k)))
|
|
|
2935
|
+ (stream:octets-to-string octets
|
|
|
2936
|
+ :external-format format)))
|
|
|
2937
|
+ (cast buffer (* c-call:char))))))
|
|
2934
|
2938
|
|
|
2935
|
2939
|
(defun unix-mkdtemp (template)
|
|
2936
|
|
- _N"Generate a uniquely named temporary directory from Template,
|
|
2937
|
|
- which must have \"XXXXXX\" as the last six characters. The
|
|
|
2940
|
+ _N"Generate a uniquely named temporary directory from Template. The
|
|
2938
|
2941
|
directory is created with permissions 0700. The name of the
|
|
2939
|
2942
|
directory is returned.
|
|
2940
|
2943
|
|
| ... |
... |
@@ -2948,19 +2951,19 @@ |
|
2948
|
2951
|
;; string can't be encoded in that format?
|
|
2949
|
2952
|
(octets (stream:string-to-octets template
|
|
2950
|
2953
|
:external-format format))
|
|
2951
|
|
- (length (length octets))
|
|
2952
|
|
- (buffer (make-array (1+ length)
|
|
2953
|
|
- :element-type '(unsigned-byte 8)
|
|
2954
|
|
- :initial-element 0)))
|
|
2955
|
|
- ;; Copy the octets from OCTETS to the null-terminated array BUFFER.
|
|
2956
|
|
- (replace buffer octets)
|
|
2957
|
|
- (let ((result (alien-funcall
|
|
2958
|
|
- (extern-alien "mkdtemp"
|
|
2959
|
|
- (function (* char)
|
|
2960
|
|
- (* char)))
|
|
2961
|
|
- (sys:vector-sap buffer))))
|
|
2962
|
|
- ;; If mkdtemp worked, a non-NIL value is returned, return the
|
|
2963
|
|
- ;; resulting name. Otherwise, return NIL and the errno.
|
|
2964
|
|
- (if (null-alien result)
|
|
2965
|
|
- (values nil (unix-errno))
|
|
2966
|
|
- (%file->name (cast result c-call:c-string)))))) |
|
|
2954
|
+ (length (length octets)))
|
|
|
2955
|
+ (with-alien ((buffer (* c-call:unsigned-char)))
|
|
|
2956
|
+ (setf buffer (make-alien c-call:unsigned-char (1+ length)))
|
|
|
2957
|
+ ;; Copy the octets from OCTETS to the null-terminated array BUFFER.
|
|
|
2958
|
+ (dotimes (k length)
|
|
|
2959
|
+ (setf (deref buffer k) (aref octets k)))
|
|
|
2960
|
+ (let ((result (alien-funcall
|
|
|
2961
|
+ (extern-alien "mkdtemp"
|
|
|
2962
|
+ (function (* char)
|
|
|
2963
|
+ (* char)))
|
|
|
2964
|
+ (cast buffer (* char)))))
|
|
|
2965
|
+ ;; If mkdtemp worked, a non-NIL value is returned, return the
|
|
|
2966
|
+ ;; resulting name. Otherwise, return NIL and the errno.
|
|
|
2967
|
+ (if (null-alien result)
|
|
|
2968
|
+ (values nil (unix-errno))
|
|
|
2969
|
+ (%file->name (cast result c-call:c-string))))))) |