diff options
Diffstat (limited to 'otherlibs/win32unix')
| -rw-r--r-- | otherlibs/win32unix/Makefile.nt | 2 | ||||
| -rw-r--r-- | otherlibs/win32unix/link.c | 41 | ||||
| -rw-r--r-- | otherlibs/win32unix/unix.ml | 2 |
3 files changed, 43 insertions, 2 deletions
diff --git a/otherlibs/win32unix/Makefile.nt b/otherlibs/win32unix/Makefile.nt index e21cd1b1f..f7931d27e 100644 --- a/otherlibs/win32unix/Makefile.nt +++ b/otherlibs/win32unix/Makefile.nt @@ -24,7 +24,7 @@ CAMLOPT=..\..\boot\ocamlrun ..\..\ocamlopt -I ..\..\stdlib WIN_OBJS = accept.obj bind.obj channels.obj close.obj \ close_on.obj connect.obj createprocess.obj dup.obj dup2.obj \ getpeername.obj getpid.obj getsockname.obj gettimeofday.obj \ - listen.obj lseek.obj \ + link.obj listen.obj lseek.obj \ mkdir.obj open.obj pipe.obj read.obj select.obj sendrecv.obj \ shutdown.obj sleep.obj socket.obj sockopt.obj startup.obj system.obj \ unixsupport.obj windir.obj winwait.obj write.obj diff --git a/otherlibs/win32unix/link.c b/otherlibs/win32unix/link.c new file mode 100644 index 000000000..cc05646cb --- /dev/null +++ b/otherlibs/win32unix/link.c @@ -0,0 +1,41 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* File contributed by Lionel Fourquaux */ +/* */ +/* Copyright 2001 Institut National de Recherche en Informatique et */ +/* en Automatique. All rights reserved. This file is distributed */ +/* under the terms of the GNU Library General Public License. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +#include <windows.h> +#include <mlvalues.h> +#include <fail.h> +#include "unixsupport.h" + +typedef +BOOL (WINAPI *tCreateHardLink)( + LPCTSTR lpFileName, + LPCTSTR lpExistingFileName, + LPSECURITY_ATTRIBUTES lpSecurityAttributes +); + +value unix_link(value path1, value path2) /* ML */ +{ + HMODULE hModKernel32; + tCreateHardLink pCreateHardLink; + hModKernel32 = GetModuleHandle("KERNEL32.DLL"); + pCreateHardLink = + (tCreateHardLink) GetProcAddress(hModKernel32, "CreateHardLinkA"); + if (pCreateHardLink == NULL) + invalid_argument("Unix.link not implemented"); + if (! pCreateHardLink(String_val(path2), String_val(path1), NULL)) { + _dosmaperr(GetLastError()); + uerror("link", path2); + } + return Val_unit; +} diff --git a/otherlibs/win32unix/unix.ml b/otherlibs/win32unix/unix.ml index 25cc960ec..1beaa9617 100644 --- a/otherlibs/win32unix/unix.ml +++ b/otherlibs/win32unix/unix.ml @@ -251,7 +251,7 @@ let fstat fd = invalid_arg "Unix.fstat not implemented" external unlink : string -> unit = "unix_unlink" external rename : string -> string -> unit = "unix_rename" -let link f1 f2 = invalid_arg "Unix.link not implemented" +external link : string -> string -> unit = "unix_link" (* File permissions and ownership *) |