(import foreign)

;; Things that the posix unit forgot
(foreign-declare #<<EOF

#include <sys/stat.h>
#include <utime.h>

double C_utime_atime;
double C_utime_mtime;
struct utimbuf C_utime_buf;

#define C_lchmod(fn, m)      C_fix(lchmod(C_data_pointer(fn), C_unfix(m)))
#define C_lchown(fn, u, g)   C_fix(lchown(C_data_pointer(fn), C_unfix(u), C_unfix(g)))
#define C_mknod(fn, m, d) C_fix(mknod(C_data_pointer(fn), C_unfix(m), C_unfix(d)))
#define C_utime(fn) C_fix((C_utime_buf.actime = C_utime_atime, C_utime_buf.modtime = C_utime_mtime, utime(C_data_pointer(fn), &C_utime_buf)))
#define C_ftell(p) C_fix(ftell(C_port_file(p)))
#define C_fseek(p, n, w) C_mk_nbool(fseek(C_port_file(p), C_unfix(n), C_unfix(w)))
#define C_lseek(fd, o, w) C_fix(lseek(C_unfix(fd), C_unfix(o), C_unfix(w)))
EOF
)

(define-foreign-variable _utime_atime double "C_utime_atime")
(define-foreign-variable _utime_mtime double "C_utime_mtime")

(define posix-error
  (let ([strerror (foreign-lambda c-string "strerror" int)]
        [string-append string-append] )
    (lambda (type loc msg . args)
      (let ([rn (##sys#update-errno)])
        (apply ##sys#signal-hook type loc (string-append msg " - " (strerror rn)) args) ) ) ) )


(define-foreign-variable _s_ifmt int "S_IFMT")
(define stat/ifmt _s_ifmt)

(define-foreign-variable _s_ififo int "S_IFIFO")
(define stat/ififo _s_ififo)
(define-foreign-variable _s_ifchr int "S_IFCHR")
(define stat/ifchr _s_ifchr)
(define-foreign-variable _s_ifdir int "S_IFDIR")
(define stat/ifdir _s_ifdir)
(define-foreign-variable _s_ifblk int "S_IFBLK")
(define stat/ifblk _s_ifblk)
(define-foreign-variable _s_ifreg int "S_IFREG")
(define stat/ifreg _s_ifreg)
(define-foreign-variable _s_iflnk int "S_IFLNK")
(define stat/iflnk _s_iflnk)
(define-foreign-variable _s_ifsock int "S_IFSOCK")
(define stat/ifsock _s_ifsock)

(define change-link-mode
   (lambda (fname m)
      (##sys#check-string fname 'change-link-mode)
      (##sys#check-exact m 'change-link-mode)
      (when (fx< (##core#inline "C_lchmod" (##sys#make-c-string (##sys#expand-home-path fname)) m) 0)
         (posix-error #:file-error 'change-link-mode "cannot change link mode" fname m))))

(define change-link-owner
   (lambda (fn uid gid)
      (##sys#check-string fn 'change-link-owner)
      (##sys#check-exact uid 'change-link-owner)
      (##sys#check-exact gid 'change-link-owner)
      (when (fx< (##core#inline "C_lchown" (##sys#make-c-string (##sys#expand-home-path fn)) uid gid) 0)
         (posix-error #:file-error 'change-link-owner "cannot change link owner" fn uid gid))))

(define create-special-file
   (lambda (fn mode devnum)
      (##sys#check-string fn 'change-link-owner)
      (##sys#check-exact mode 'change-link-owner)
      (##sys#check-exact devnum 'change-link-owner)
      (when (fx< (##core#inline "C_mknod" (##sys#make-c-string (##sys#expand-home-path fn)) mode devnum) 0)
         (posix-error #:file-error 'make-special-file "cannot make special file" fn mode devnum))))

(define (change-file-times fn atime mtime)
   (##sys#check-string fn 'change-file-times)
   (##sys#check-number atime 'change-file-times)
   (##sys#check-number mtime 'change-file-times)
   
   (set! _utime_atime atime)
   (set! _utime_mtime mtime)
   
   (when (fx< (##core#inline "C_utime" (##sys#make-c-string (##sys#expand-home-path fn))) 0)
      (posix-error #:file-error 'change-file-times "cannot change file times" fn atime mtime)))
   
 
;; (define-foreign-variable _seek_set int "SEEK_SET")
;; (define-foreign-variable _seek_cur int "SEEK_CUR")
;; (define-foreign-variable _seek_end int "SEEK_END")
 
;; (define set-file-position!
;;    (lambda (port pos . whence)
;;      (let ([whence (if (pair? whence) (car whence) _seek_set)])
;;        (##sys#check-exact pos 'set-file-position!)
;;        (##sys#check-exact whence 'set-file-position!)
;;        (when (fx< pos 0) (##sys#signal-hook #:bounds-error 'set-file-position! "invalid negative port position" pos port))
;;        (unless (cond [(port? port)
;;      (and (eq? (##sys#slot port 7) 'stream)
;;        (##core#inline "C_fseek" port pos whence) ) ]
;;      [(fixnum? port) (##core#inline "C_lseek" port pos whence)]
;;      [else (##sys#signal-hook #:type-error 'set-file-position! "invalid file" port)] )
;;    (posix-error #:file-error 'set-file-position! "cannot set file position" port pos) ) ) ) )