/* make realpath(3c) function available in ocaml */

#include <limits.h>
#include <stdlib.h>
#include <stdio.h>
#include <errno.h>

#include <caml/mlvalues.h>
#include <caml/fail.h>
#include <caml/alloc.h>
#include <string.h>
#include <sys/utsname.h>
#include <sys/syscall.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/sysmacros.h>
#include <fcntl.h>
#include <unistd.h>

#ifndef PATH_MAX
#ifdef MAXPATHLEN
#define PATH_MAX MAXPATHLEN
#else
#define PATH_MAX 512
#endif
#endif

#define Nothing ((value) 0)

CAMLprim value realpath_native(value path) {
    char rpath[PATH_MAX];

    if (realpath(String_val(path),rpath) == NULL) failwith(strerror(errno));

    return copy_string(rpath);
}    
    

CAMLprim value openlog_native(value ident, value option, value facility) {
    openlog(strdup(String_val(ident)), Int_val(option), Int_val(facility));
    return Val_unit;
}    
    

CAMLprim value syslog_native(value priority, value message) {
    syslog(Int_val(priority), String_val(message));
    return Val_unit;
}    
    

CAMLprim value closelog_native() {
    closelog();
    return Val_unit;
}    
    
CAMLprim value fchdir_native(value fd)
{
  if (fchdir(Int_val(fd)) == -1)
      failwith(strerror(errno));
  return Val_unit;
}

CAMLprim value seteuid_native(value m0) {
    typeof (Int_val(m0)) c0 = Int_val(m0);
    if (seteuid(c0) == -1) uerror("seteuid", m0);
    return Val_unit;
}

CAMLprim value setresuid_native(value m0, value m1, value m2) {
    typeof (Int_val(m0)) c0 = Int_val(m0);
    typeof (Int_val(m1)) c1 = Int_val(m1);
    typeof (Int_val(m2)) c2 = Int_val(m2);
    if (setresuid(c0, c1, c2) == -1) uerror("setresuid", Nothing);
    return Val_unit;
}

CAMLprim value lchown_native(value path, value owner, value group) {
    if (lchown(String_val(path), Int_val(owner), Int_val(group)) == -1) 
	uerror("lchown", path);
    return Val_unit;
}    

#include <sys/mount.h>
//#include <sys/fs.h>
#define MNT_DETACH 0x2

static int mount_flag_table[] = {
  MS_RDONLY, MS_NOSUID, MS_NODEV, MS_NOEXEC, MS_SYNCHRONOUS, MS_REMOUNT,
  MS_MANDLOCK, /*MS_DIRSYNC,*/ MS_NOATIME, MS_NODIRATIME, MS_BIND, /*MS_MOVE,
  MS_REC, MS_VERBOSE, MS_POSIXACL, MS_ONE_SECOND, MS_ACTIVE, MS_NOUSER */
};

#include <stdio.h>

CAMLprim value mount_native(value m0, value m1, value m2, value m3, value m4) {
  char *source = String_val(m0);
  char *target = String_val(m1);
  char *filesystemtype = String_val(m2);
  int cv_flags = caml_convert_flag_list(m3, mount_flag_table);
  char *data = String_val(m4);
  //fprintf(stderr, "source=%s\n", source);
  //fprintf(stderr, "target=%s\n", target);
  //fprintf(stderr, "filesystemtype=%s\n", filesystemtype);
  //fprintf(stderr, "flags=%ld\n", cv_flags);
  //fprintf(stderr, "data=%s\n", data);
  switch (mount(source, target, filesystemtype, cv_flags, data)) {
  case 0: return Val_unit;
  default: uerror("mount", m0);
  }
}

CAMLprim value umount_native(value m0) {
  char *target = String_val(m0);
  switch (umount(target)) {
  case 0: return Val_unit;
  default: uerror("umount", m0);
  }
}

static int umount2_flag_table[] = {
  MNT_FORCE, MNT_DETACH
};

CAMLprim value umount2_native(value m0, value m1) {
  char *target = String_val(m0);
  int flags = caml_convert_flag_list(m1, umount2_flag_table);
  switch (umount2(target, flags)) {
  case 0: return Val_unit;
  default: uerror("umount2", m0);
  }
}

static int file_kind_table[] = {
  S_IFREG, S_IFDIR, S_IFCHR, S_IFBLK, S_IFLNK, S_IFIFO, S_IFSOCK
};

CAMLprim value mknod_native(value pathname, value kind, value mode, value major, value minor)
{
  mode_t m = Int_val(mode);
  mode_t node_type = file_kind_table[Int_val(kind)];
  int dev = makedev(Int_val(major), Int_val(minor));
  
  if (mknod(String_val(pathname), m | node_type, dev) != 0) {
    uerror("mknode", pathname);
  }

  return Val_unit;
}

#define pivot_root(new_root,put_old) syscall(SYS_pivot_root,new_root,put_old)

CAMLprim value pivot_root_native(value newroot, value put_old) {
  if (pivot_root(String_val(newroot), String_val(put_old)) < 0) {
    uerror("pivot_root", newroot);
  }
  return Val_unit;
}

#include <sys/stat.h>

extern long init_module(void *, unsigned long, const char *);

CAMLprim value init_module_native(value filename, value options) {
  off_t len;
  int fd, ret;
  struct stat stbuf;
  void *buf;

  fd = open(String_val(filename), O_RDONLY, 0);
  if (fd < 0) {
    uerror("init_module", filename);
  }

  if (fstat(fd, &stbuf) < 0) {
    uerror("init_module (fstat)", filename);
  }

  buf = malloc(stbuf.st_size);
  len = read(fd, buf, stbuf.st_size);
  if (len < stbuf.st_size) {
    free(buf);
    uerror("init_module (read)", filename);
  }

  if ((ret = init_module(buf, len, String_val(options))) < 0) {
    free(buf);
    uerror("init_module", Val_unit);
  }

  free(buf);
  return Val_unit;
}

#include <sys/utsname.h>

CAMLprim value uname_r_native() {
  struct utsname utsname;
  switch (uname(&utsname)) {
  case 0: return copy_string(utsname.release);
  case -1: failwith(strerror(errno));
  }
}

value pipe_buf_native() {return Val_int(PIPE_BUF);}