1 /* Part of SWI-Prolog
2
3 Author: Jan Wielemaker
4 E-mail: J.Wielemaker@vu.nl
5 WWW: http://www.swi-prolog.org
6 Copyright (c) 1995-2019, University of Amsterdam
7 CWI, Amsterdam
8 All rights reserved.
9
10 Redistribution and use in source and binary forms, with or without
11 modification, are permitted provided that the following conditions
12 are met:
13
14 1. Redistributions of source code must retain the above copyright
15 notice, this list of conditions and the following disclaimer.
16
17 2. Redistributions in binary form must reproduce the above copyright
18 notice, this list of conditions and the following disclaimer in
19 the documentation and/or other materials provided with the
20 distribution.
21
22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
33 POSSIBILITY OF SUCH DAMAGE.
34 */
35
36 #ifdef __WINDOWS__
37 #include <winsock2.h> /* Needed on VC8 */
38 #include <windows.h>
39
40 #ifdef __MINGW32__
41 #ifndef _WIN32_IE
42 #define _WIN32_IE 0x0400
43 #endif
44 /* FIXME: these are copied from SWI-Prolog.h. */
45 #define PL_MSG_EXCEPTION_RAISED -1
46 #define PL_MSG_IGNORED 0
47 #define PL_MSG_HANDLED 1
48 #endif
49
50 #include "pl-incl.h"
51 #include "os/pl-utf8.h"
52 #include <process.h>
53 #include "os/pl-ctype.h"
54 #include <stdio.h>
55 #include <stdarg.h>
56 #include "os/SWI-Stream.h"
57 #include <process.h>
58 #include <winbase.h>
59 #ifdef HAVE_CRTDBG_H
60 #include <crtdbg.h>
61 #endif
62
63
64 /*******************************
65 * CONSOLE *
66 *******************************/
67
68 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
69 There is no way to tell which subsystem an app belongs too, except for
70 peeking in its executable-header. This is a bit too much ...
71 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
72
73 int
hasConsole(void)74 hasConsole(void)
75 { HANDLE h;
76
77 if ( GD->os.gui_app == FALSE ) /* has been set explicitly */
78 succeed;
79
80 /* I found a console */
81 if ( (h = GetStdHandle(STD_OUTPUT_HANDLE)) != INVALID_HANDLE_VALUE )
82 { DWORD mode;
83
84 if ( GetConsoleMode(h, &mode) )
85 succeed;
86 }
87
88 /* assume we are GUI */
89 fail;
90 }
91
92
93 int
PL_wait_for_console_input(void * handle)94 PL_wait_for_console_input(void *handle)
95 { BOOL rc;
96 HANDLE hConsole = handle;
97
98 for(;;)
99 { rc = MsgWaitForMultipleObjects(1,
100 &hConsole,
101 FALSE, /* wait for either event */
102 INFINITE,
103 QS_ALLINPUT);
104
105 if ( rc == WAIT_OBJECT_0+1 )
106 { MSG msg;
107
108 while( PeekMessage(&msg, NULL, 0, 0, PM_REMOVE) )
109 { TranslateMessage(&msg);
110 DispatchMessage(&msg);
111 }
112 } else if ( rc == WAIT_OBJECT_0 )
113 { return TRUE;
114 } else
115 { DEBUG(MSG_WIN_API,
116 Sdprintf("MsgWaitForMultipleObjects(): 0x%x\n", rc));
117 }
118 }
119 }
120
121
122 /*******************************
123 * MESSAGE BOX *
124 *******************************/
125
126 void
PlMessage(const char * fm,...)127 PlMessage(const char *fm, ...)
128 { va_list(args);
129
130 va_start(args, fm);
131
132 if ( hasConsole() )
133 { Sfprintf(Serror, "SWI-Prolog: ");
134 Svfprintf(Serror, fm, args);
135 Sfprintf(Serror, "\n");
136 } else
137 { char buf[1024];
138 int64_t hwndi;
139 HWND hwnd = NULL;
140 static atom_t ATOM_hwnd = 0;
141
142 if ( !ATOM_hwnd )
143 ATOM_hwnd = PL_new_atom("hwnd");
144
145 if ( PL_current_prolog_flag(ATOM_hwnd, PL_INTEGER, &hwndi) )
146 hwnd = (HWND)(uintptr_t)hwndi;
147
148 vsprintf(buf, fm, args);
149 MessageBox(hwnd, buf, "SWI-Prolog", MB_OK|MB_TASKMODAL);
150 }
151
152 va_end(args);
153 }
154
155
156
157 /*******************************
158 * WinAPI ERROR CODES *
159 *******************************/
160
161 const char *
WinError(void)162 WinError(void)
163 { int id = GetLastError();
164 char *msg;
165 static WORD lang;
166 static int lang_initialised = 0;
167
168 if ( !lang_initialised )
169 lang = MAKELANGID(LANG_ENGLISH, SUBLANG_ENGLISH_UK);
170
171 again:
172 if ( FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER|
173 FORMAT_MESSAGE_IGNORE_INSERTS|
174 FORMAT_MESSAGE_FROM_SYSTEM,
175 NULL, /* source */
176 id, /* identifier */
177 lang,
178 (LPTSTR) &msg,
179 0, /* size */
180 NULL) ) /* arguments */
181 { atom_t a = PL_new_atom(msg);
182
183 LocalFree(msg);
184 lang_initialised = 1;
185
186 return stringAtom(a);
187 } else
188 { if ( lang_initialised == 0 )
189 { lang = MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT);
190 lang_initialised = 1;
191 goto again;
192 }
193
194 return "Unknown Windows error";
195 }
196 }
197
198
199 /*******************************
200 * SLEEP/1 SUPPORT *
201 *******************************/
202
203 int
Pause(double t)204 Pause(double t)
205 { HANDLE h;
206
207 if ( (h = CreateWaitableTimer(NULL, TRUE, NULL)) )
208 { LARGE_INTEGER ft;
209
210 ft.QuadPart = -(LONGLONG)(t * 10000000.0); /* 100 nanosecs per tick */
211
212 SetWaitableTimer(h, &ft, 0, NULL, NULL, FALSE);
213 for(;;)
214 { int rc = MsgWaitForMultipleObjects(1,
215 &h,
216 FALSE,
217 INFINITE,
218 QS_ALLINPUT);
219 if ( rc == WAIT_OBJECT_0+1 )
220 { MSG msg;
221
222 while( PeekMessage(&msg, NULL, 0, 0, PM_REMOVE) )
223 { TranslateMessage(&msg);
224 DispatchMessage(&msg);
225 }
226
227 if ( PL_handle_signals() < 0 )
228 { CloseHandle(h);
229 return FALSE;
230 }
231 } else
232 break;
233 }
234 CloseHandle(h);
235
236 return TRUE;
237 } else /* Pre NT implementation */
238 { DWORD msecs = (DWORD)(t * 1000.0);
239
240 while( msecs >= 100 )
241 { Sleep(100);
242 if ( PL_handle_signals() < 0 )
243 return FALSE;
244 msecs -= 100;
245 }
246 if ( msecs > 0 )
247 Sleep(msecs);
248
249 return TRUE;
250 }
251 }
252
253
254 /*******************************
255 * SET FILE SIZE *
256 *******************************/
257
258 #ifndef HAVE_FTRUNCATE
259
260 int
ftruncate(int fileno,int64_t length)261 ftruncate(int fileno, int64_t length)
262 { errno_t e;
263
264 if ( (e=_chsize_s(fileno, length)) == 0 )
265 return 0;
266
267 errno = e;
268 return -1;
269 }
270
271 #endif
272
273
274 /*******************************
275 * QUERY CPU TIME *
276 *******************************/
277
278 #define nano * 0.0000001
279 #define ntick 1.0 /* manual says 100.0 ??? */
280
281 double
CpuTime(cputime_kind which)282 CpuTime(cputime_kind which)
283 { double t;
284 HANDLE proc = GetCurrentProcess();
285 FILETIME created, exited, kerneltime, usertime;
286
287 if ( GetProcessTimes(proc, &created, &exited, &kerneltime, &usertime) )
288 { FILETIME *p;
289
290 switch ( which )
291 { case CPU_USER:
292 p = &usertime;
293 break;
294 case CPU_SYSTEM:
295 p = &kerneltime;
296 break;
297 default:
298 assert(0);
299 return 0.0;
300 }
301 t = (double)p->dwHighDateTime * (4294967296.0 * ntick nano);
302 t += (double)p->dwLowDateTime * (ntick nano);
303 } else /* '95, Windows 3.1/win32s */
304 { t = 0.0;
305 }
306
307 return t;
308 }
309
310
311 int
CpuCount(void)312 CpuCount(void)
313 { SYSTEM_INFO si;
314
315 GetSystemInfo(&si);
316
317 return si.dwNumberOfProcessors;
318 }
319
320
321 void
setOSPrologFlags(void)322 setOSPrologFlags(void)
323 { PL_set_prolog_flag("cpu_count", PL_INTEGER, CpuCount());
324 }
325
326
327 char *
findExecutable(const char * module,char * exe,size_t exelen)328 findExecutable(const char *module, char *exe, size_t exelen)
329 { int n;
330 wchar_t wbuf[MAXPATHLEN];
331 HMODULE hmod;
332
333 if ( module )
334 { if ( !(hmod = GetModuleHandle(module)) )
335 { hmod = GetModuleHandle("libswipl.dll");
336 DEBUG(MSG_WIN_API,
337 Sdprintf("Warning: could not find module from \"%s\"\n"
338 "Warning: Trying %s to find home\n",
339 module,
340 hmod ? "\"LIBPL.DLL\"" : "executable"));
341 }
342 } else
343 hmod = NULL;
344
345 if ( (n = GetModuleFileNameW(hmod, wbuf, MAXPATHLEN)) > 0 )
346 { wbuf[n] = EOS;
347 return _xos_long_file_name_toA(wbuf, exe, exelen);
348 } else if ( module )
349 { return PrologPath(module, exe, exelen);
350 } else
351 *exe = EOS;
352
353 return exe;
354 }
355
356 /*******************************
357 * SUPPORT FOR SHELL/2 *
358 *******************************/
359
360 typedef struct
361 { const char *name;
362 UINT id;
363 } showtype;
364
365 static int
get_showCmd(term_t show,UINT * cmd)366 get_showCmd(term_t show, UINT *cmd)
367 { char *s;
368 showtype *st;
369 static showtype types[] =
370 { { "hide", SW_HIDE },
371 { "maximize", SW_MAXIMIZE },
372 { "minimize", SW_MINIMIZE },
373 { "restore", SW_RESTORE },
374 { "show", SW_SHOW },
375 { "showdefault", SW_SHOWDEFAULT },
376 { "showmaximized", SW_SHOWMAXIMIZED },
377 { "showminimized", SW_SHOWMINIMIZED },
378 { "showminnoactive", SW_SHOWMINNOACTIVE },
379 { "showna", SW_SHOWNA },
380 { "shownoactive", SW_SHOWNOACTIVATE },
381 { "shownormal", SW_SHOWNORMAL },
382 /* compatibility */
383 { "normal", SW_SHOWNORMAL },
384 { "iconic", SW_MINIMIZE },
385 { NULL, 0 },
386 };
387
388 if ( show == 0 )
389 { *cmd = SW_SHOWNORMAL;
390 succeed;
391 }
392
393 if ( !PL_get_chars(show, &s, CVT_ATOM|CVT_EXCEPTION) )
394 fail;
395 for(st=types; st->name; st++)
396 { if ( streq(st->name, s) )
397 { *cmd = st->id;
398 succeed;
399 }
400 }
401
402 return PL_error(NULL, 0, NULL, ERR_DOMAIN,
403 PL_new_atom("win_show"), show);
404 }
405
406
407
408 static int
win_exec(size_t len,const wchar_t * cmd,UINT show)409 win_exec(size_t len, const wchar_t *cmd, UINT show)
410 { GET_LD
411 STARTUPINFOW startup;
412 PROCESS_INFORMATION info;
413 int rval;
414 wchar_t *wcmd;
415
416 memset(&startup, 0, sizeof(startup));
417 startup.cb = sizeof(startup);
418 startup.wShowWindow = show;
419
420 /* ensure 0-terminated */
421 wcmd = PL_malloc((len+1)*sizeof(wchar_t));
422 memcpy(wcmd, cmd, len*sizeof(wchar_t));
423 wcmd[len] = 0;
424
425 rval = CreateProcessW(NULL, /* app */
426 wcmd,
427 NULL, NULL, /* security */
428 FALSE, /* inherit handles */
429 0, /* flags */
430 NULL, /* environment */
431 NULL, /* Directory */
432 &startup,
433 &info); /* process info */
434 PL_free(wcmd);
435
436 if ( rval )
437 { CloseHandle(info.hProcess);
438 CloseHandle(info.hThread);
439
440 succeed;
441 } else
442 { term_t tmp = PL_new_term_ref();
443
444 return ( PL_unify_wchars(tmp, PL_ATOM, len, cmd) &&
445 PL_error(NULL, 0, WinError(), ERR_SHELL_FAILED, tmp)
446 );
447 }
448 }
449
450
451 static void
utf8towcs(wchar_t * o,const char * src)452 utf8towcs(wchar_t *o, const char *src)
453 { for( ; *src; )
454 { int wc;
455
456 src = utf8_get_char(src, &wc);
457 *o++ = wc;
458 }
459 *o = 0;
460 }
461
462
463 int
System(char * command)464 System(char *command) /* command is a UTF-8 string */
465 { STARTUPINFOW sinfo;
466 PROCESS_INFORMATION pinfo;
467 int shell_rval;
468 size_t len;
469 wchar_t *wcmd;
470
471 memset(&sinfo, 0, sizeof(sinfo));
472 sinfo.cb = sizeof(sinfo);
473
474 len = utf8_strlen(command, strlen(command));
475 wcmd = PL_malloc((len+1)*sizeof(wchar_t));
476 utf8towcs(wcmd, command);
477
478 if ( CreateProcessW(NULL, /* module */
479 wcmd, /* command line */
480 NULL, /* Security stuff */
481 NULL, /* Thread security stuff */
482 FALSE, /* Inherit handles */
483 CREATE_NO_WINDOW, /* flags */
484 NULL, /* environment */
485 NULL, /* CWD */
486 &sinfo, /* startup info */
487 &pinfo) ) /* process into */
488 { BOOL rval;
489 DWORD code;
490
491 CloseHandle(pinfo.hThread); /* don't need this */
492 PL_free(wcmd);
493
494 do
495 { MSG msg;
496
497 if ( PeekMessage(&msg, NULL, 0, 0, PM_REMOVE) )
498 { TranslateMessage(&msg);
499 DispatchMessage(&msg);
500 } else
501 Sleep(50);
502
503 rval = GetExitCodeProcess(pinfo.hProcess, &code);
504 } while(rval == TRUE && code == STILL_ACTIVE);
505
506 shell_rval = (rval == TRUE ? code : -1);
507 CloseHandle(pinfo.hProcess);
508 } else
509 { PL_free(wcmd);
510 return shell_rval = -1;
511 }
512
513 return shell_rval;
514 }
515
516
517 word
pl_win_exec(term_t cmd,term_t how)518 pl_win_exec(term_t cmd, term_t how)
519 { wchar_t *s;
520 size_t len;
521 UINT h;
522
523 if ( PL_get_wchars(cmd, &len, &s, CVT_ALL|CVT_EXCEPTION) &&
524 get_showCmd(how, &h) )
525 { return win_exec(len, s, h);
526 } else
527 fail;
528 }
529
530 typedef struct
531 { int eno;
532 const char *message;
533 } shell_error;
534
535 static const shell_error se_errors[] =
536 { { 0 , "Out of memory or resources" },
537 { ERROR_FILE_NOT_FOUND, "File not found" },
538 { ERROR_PATH_NOT_FOUND, "path not found" },
539 { ERROR_BAD_FORMAT, "Invalid .EXE" },
540 { SE_ERR_ACCESSDENIED, "Access denied" },
541 { SE_ERR_ASSOCINCOMPLETE, "Incomplete association" },
542 { SE_ERR_DDEBUSY, "DDE server busy" },
543 { SE_ERR_DDEFAIL, "DDE transaction failed" },
544 { SE_ERR_DDETIMEOUT, "DDE request timed out" },
545 { SE_ERR_DLLNOTFOUND, "DLL not found" },
546 { SE_ERR_FNF, "File not found (FNF)" },
547 { SE_ERR_NOASSOC, "No association" },
548 { SE_ERR_OOM, "Not enough memory" },
549 { SE_ERR_PNF, "Path not found (PNF)" },
550 { SE_ERR_SHARE, "Sharing violation" },
551 { 0, NULL }
552 };
553
554
555 static int
win_shell(term_t op,term_t file,term_t how)556 win_shell(term_t op, term_t file, term_t how)
557 { size_t lo, lf;
558 wchar_t *o, *f;
559 UINT h;
560 HINSTANCE instance;
561
562 if ( !PL_get_wchars(op, &lo, &o, CVT_ALL|CVT_EXCEPTION|BUF_STACK) ||
563 !PL_get_wchars(file, &lf, &f, CVT_ALL|CVT_EXCEPTION|BUF_STACK) ||
564 !get_showCmd(how, &h) )
565 fail;
566
567 instance = ShellExecuteW(NULL, o, f, NULL, NULL, h);
568
569 if ( (intptr_t)instance <= 32 )
570 { const shell_error *se;
571
572 for(se = se_errors; se->message; se++)
573 { if ( se->eno == (int)(intptr_t)instance )
574 return PL_error(NULL, 0, se->message, ERR_SHELL_FAILED, file);
575 }
576 PL_error(NULL, 0, NULL, ERR_SHELL_FAILED, file);
577 }
578
579 succeed;
580 }
581
582
583 static
584 PRED_IMPL("win_shell", 2, win_shell2, 0)
585 { return win_shell(A1, A2, 0);
586 }
587
588
589 static
590 PRED_IMPL("win_shell", 3, win_shell3, 0)
591 { return win_shell(A1, A2, A3);
592 }
593
594
595 foreign_t
pl_win_module_file(term_t module,term_t file)596 pl_win_module_file(term_t module, term_t file)
597 { char buf[MAXPATHLEN];
598 char *m;
599 char *f;
600
601 if ( !PL_get_chars(module, &m, CVT_ALL|CVT_EXCEPTION) )
602 fail;
603 if ( (f = findExecutable(m, buf, sizeof(buf))) )
604 return PL_unify_atom_chars(file, f);
605
606 fail;
607 }
608
609 /*******************************
610 * WINDOWS MESSAGES *
611 *******************************/
612
613 LRESULT
PL_win_message_proc(HWND hwnd,UINT message,WPARAM wParam,LPARAM lParam)614 PL_win_message_proc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam)
615 {
616 #ifdef O_PLMT
617 if ( hwnd == NULL &&
618 message == WM_SIGNALLED &&
619 wParam == 0 && /* or another constant? */
620 lParam == 0 )
621 { if ( PL_handle_signals() < 0 )
622 return PL_MSG_EXCEPTION_RAISED;
623
624 return PL_MSG_HANDLED;
625 }
626 #endif
627
628 return PL_MSG_IGNORED;
629 }
630
631
632 /*******************************
633 * DLOPEN AND FRIENDS *
634 *******************************/
635
636 #ifdef EMULATE_DLOPEN
637
638 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
639 These functions emulate the bits from the ELF shared object interface we
640 need. They are used by pl-load.c, which defines the actual Prolog
641 interface.
642 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
643
644 #ifdef HAVE_LIBLOADERAPI_H
645 #include <LibLoaderAPI.h>
646 #else
647 #ifndef LOAD_LIBRARY_SEARCH_DLL_LOAD_DIR
648 #define LOAD_LIBRARY_SEARCH_DLL_LOAD_DIR 0x00000100
649 #endif
650 #ifndef LOAD_LIBRARY_SEARCH_DEFAULT_DIRS
651 #define LOAD_LIBRARY_SEARCH_DEFAULT_DIRS 0x00001000
652 #endif
653 typedef void * DLL_DIRECTORY_COOKIE;
654 #endif
655
656 static const char *dlmsg;
657 static DLL_DIRECTORY_COOKIE (WINAPI *f_AddDllDirectoryW)(wchar_t* dir);
658 static BOOL (WINAPI *f_RemoveDllDirectory)(DLL_DIRECTORY_COOKIE);
659
660 static DWORD
load_library_search_flags(void)661 load_library_search_flags(void)
662 { static int done = FALSE;
663 static DWORD flags = 0;
664
665 if ( !done )
666 { HMODULE kernel = GetModuleHandle(TEXT("kernel32.dll"));
667
668 if ( (f_AddDllDirectoryW = (void*)GetProcAddress(kernel, "AddDllDirectory")) &&
669 (f_RemoveDllDirectory = (void*)GetProcAddress(kernel, "RemoveDllDirectory")) )
670 { flags = ( LOAD_LIBRARY_SEARCH_DLL_LOAD_DIR|
671 LOAD_LIBRARY_SEARCH_DEFAULT_DIRS );
672 DEBUG(MSG_WIN_API,
673 Sdprintf("LoadLibraryExW() flags are supported\n"));
674 } else
675 { DEBUG(MSG_WIN_API,
676 Sdprintf("LoadLibraryExW() flags are NOT supported\n"));
677 }
678 done = TRUE;
679 }
680
681 return flags;
682 }
683
684
685 static
686 PRED_IMPL("win_add_dll_directory", 2, win_add_dll_directory, 0)
687 { PRED_LD
688 char *dirs;
689
690 if ( PL_get_file_name(A1, &dirs, REP_UTF8) )
691 { size_t len = utf8_strlen(dirs, strlen(dirs));
692 wchar_t *dirw = alloca((len+10)*sizeof(wchar_t));
693 DLL_DIRECTORY_COOKIE cookie;
694
695 if ( _xos_os_filenameW(dirs, dirw, len+10) == NULL )
696 return PL_representation_error("file_name");
697 if ( load_library_search_flags() )
698 { if ( (cookie = (*f_AddDllDirectoryW)(dirw)) )
699 { DEBUG(MSG_WIN_API,
700 Sdprintf("AddDllDirectory(%Ws) ok\n", dirw));
701
702 return PL_unify_int64(A2, (int64_t)(uintptr_t)cookie);
703 }
704 return PL_error(NULL, 0, WinError(), ERR_SYSCALL, "AddDllDirectory()");
705 } else
706 return FALSE;
707 } else
708 return FALSE;
709 }
710
711
712 static
713 PRED_IMPL("win_remove_dll_directory", 1, win_remove_dll_directory, 0)
714 { int64_t icookie;
715
716 if ( PL_get_int64_ex(A1, &icookie) )
717 { if ( f_RemoveDllDirectory )
718 { if ( (*f_RemoveDllDirectory)((DLL_DIRECTORY_COOKIE)(uintptr_t)icookie) )
719 return TRUE;
720
721 return PL_error(NULL, 0, WinError(), ERR_SYSCALL, "RemoveDllDirectory()");
722 } else
723 return FALSE;
724 } else
725 return FALSE;
726 }
727
728
729 static int
is_windows_abs_path(const wchar_t * path)730 is_windows_abs_path(const wchar_t *path)
731 { if ( path[1] == ':' && path[0] < 0x80 && iswalpha(path[0]) )
732 return TRUE; /* drive */
733 if ( path[0] == '\\' && path[1] == '\\' )
734 return TRUE; /* UNC */
735
736 return FALSE;
737 }
738
739 void *
PL_dlopen(const char * file,int flags)740 PL_dlopen(const char *file, int flags) /* file is in UTF-8, POSIX path */
741 { HINSTANCE h;
742 DWORD llflags = 0;
743 size_t len = utf8_strlen(file, strlen(file));
744 wchar_t *wfile = alloca((len+10)*sizeof(wchar_t));
745
746 if ( !wfile )
747 { dlmsg = "No memory";
748 return NULL;
749 }
750
751 if ( _xos_os_filenameW(file, wfile, len+10) == NULL )
752 { dlmsg = "Name too long";
753 return NULL;
754 }
755
756 DEBUG(MSG_WIN_API, Sdprintf("dlopen(%Ws)\n", wfile));
757
758 if ( is_windows_abs_path(wfile) )
759 llflags |= load_library_search_flags();
760
761 if ( (h = LoadLibraryExW(wfile, NULL, llflags)) )
762 { dlmsg = "No Error";
763 return (void *)h;
764 }
765
766 dlmsg = WinError();
767 return NULL;
768 }
769
770
771 const char *
PL_dlerror(void)772 PL_dlerror(void)
773 { return dlmsg;
774 }
775
776
777 void *
PL_dlsym(void * handle,char * symbol)778 PL_dlsym(void *handle, char *symbol)
779 { void *addr = GetProcAddress(handle, symbol);
780
781 if ( addr )
782 { dlmsg = "No Error";
783 return addr;
784 }
785
786 dlmsg = WinError();
787 return NULL;
788 }
789
790
791 int
PL_dlclose(void * handle)792 PL_dlclose(void *handle)
793 { FreeLibrary(handle);
794
795 return 0;
796 }
797
798 #endif /*EMULATE_DLOPEN*/
799
800
801 /*******************************
802 * SNPRINTF MADNESS *
803 *******************************/
804
805 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
806 MS-Windows _snprintf() may look like C99 snprintf(), but is is not quite
807 the same: on overflow, the buffer is *not* 0-terminated and the return
808 is negative (unspecified how negative). The code below works around
809 this, returning count on overflow. This is still not the same as the C99
810 version that returns the number of characters that would have been
811 written, but it seems to be enough for our purposes.
812
813 See http://www.di-mgt.com.au/cprog.html#snprintf
814
815 The above came from the provided link, but it is even worse (copied from
816 VS2005 docs):
817
818 - If len < count, then len characters are stored in buffer, a
819 null-terminator is appended, and len is returned.
820
821 - If len = count, then len characters are stored in buffer, no
822 null-terminator is appended, and len is returned.
823
824 - If len > count, then count characters are stored in buffer, no
825 null-terminator is appended, and a negative value is returned.
826 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
827
828 int
ms_snprintf(char * buffer,size_t count,const char * fmt,...)829 ms_snprintf(char *buffer, size_t count, const char *fmt, ...)
830 { va_list ap;
831 int ret;
832
833 va_start(ap, fmt);
834 ret = _vsnprintf(buffer, count-1, fmt, ap);
835 va_end(ap);
836
837 if ( ret < 0 || ret == count )
838 { ret = (int)count;
839 buffer[count-1] = '\0';
840 }
841
842 return ret;
843 }
844
845
846
847 /*******************************
848 * FOLDERS *
849 *******************************/
850
851 #ifdef HAVE_SHLOBJ_H
852 #include <shlobj.h>
853 #endif
854
855 typedef struct folderid
856 { int csidl;
857 const char *name;
858 } folderid;
859
860 static const folderid folderids[] =
861 { { CSIDL_COMMON_ALTSTARTUP, "common_altstartup" },
862 { CSIDL_ALTSTARTUP, "altstartup" },
863 { CSIDL_APPDATA, "appdata" },
864 { CSIDL_COMMON_APPDATA, "common_appdata" },
865 { CSIDL_LOCAL_APPDATA, "local_appdata" },
866 { CSIDL_CONTROLS, "controls" },
867 { CSIDL_COOKIES, "cookies" },
868 { CSIDL_DESKTOP, "desktop" },
869 { CSIDL_COMMON_DESKTOPDIRECTORY, "common_desktopdirectory" },
870 { CSIDL_DESKTOPDIRECTORY, "desktopdirectory" },
871 { CSIDL_COMMON_FAVORITES, "common_favorites" },
872 { CSIDL_FAVORITES, "favorites" },
873 { CSIDL_FONTS, "fonts" },
874 { CSIDL_HISTORY, "history" },
875 { CSIDL_INTERNET_CACHE, "internet_cache" },
876 { CSIDL_INTERNET, "internet" },
877 { CSIDL_DRIVES, "drives" },
878 { CSIDL_PERSONAL, "personal" },
879 { CSIDL_NETWORK, "network" },
880 { CSIDL_NETHOOD, "nethood" },
881 { CSIDL_PERSONAL, "personal" },
882 { CSIDL_PRINTERS, "printers" },
883 { CSIDL_PRINTHOOD, "printhood" },
884 { CSIDL_COMMON_PROGRAMS, "common_programs" },
885 { CSIDL_PROGRAMS, "programs" },
886 { CSIDL_RECENT, "recent" },
887 { CSIDL_BITBUCKET, "bitbucket" },
888 { CSIDL_SENDTO, "sendto" },
889 { CSIDL_COMMON_STARTMENU, "common_startmenu" },
890 { CSIDL_STARTMENU, "startmenu" },
891 { CSIDL_COMMON_STARTUP, "common_startup" },
892 { CSIDL_STARTUP, "startup" },
893 { CSIDL_TEMPLATES, "templates" },
894 { 0, NULL }
895 };
896
897
898 static int
unify_csidl_path(term_t t,int csidl)899 unify_csidl_path(term_t t, int csidl)
900 { wchar_t buf[MAX_PATH];
901
902 if ( SHGetSpecialFolderPathW(0, buf, csidl, FALSE) )
903 { wchar_t *p;
904
905 for(p=buf; *p; p++)
906 { if ( *p == '\\' )
907 *p = '/';
908 }
909
910 return PL_unify_wchars(t, PL_ATOM, -1, buf);
911 } else
912 return PL_error(NULL, 0, WinError(), ERR_SYSCALL, "SHGetSpecialFolderPath");
913 }
914
915
916 static
917 PRED_IMPL("win_folder", 2, win_folder, PL_FA_NONDETERMINISTIC)
918 { GET_LD
919 int n;
920
921 switch( CTX_CNTRL )
922 { case FRG_FIRST_CALL:
923 if ( PL_is_variable(A1) )
924 { n = 0;
925 goto generate;
926 } else
927 { char *s;
928
929 if ( PL_get_chars(A1, &s, CVT_ATOM|CVT_EXCEPTION) )
930 { const folderid *fid;
931
932 for(fid = folderids; fid->name; fid++)
933 { if ( streq(s, fid->name) )
934 return unify_csidl_path(A2, fid->csidl);
935 }
936
937 { atom_t dom = PL_new_atom("win_folder");
938
939 PL_error(NULL, 0, NULL, ERR_DOMAIN, dom, A1);
940 PL_unregister_atom(dom);
941 return FALSE;
942 }
943 } else
944 return FALSE;
945 }
946 case FRG_REDO:
947 { fid_t fid;
948
949 n = (int)CTX_INT+1;
950
951 generate:
952 fid = PL_open_foreign_frame();
953 for(; folderids[n].name; n++)
954 { if ( unify_csidl_path(A2, folderids[n].csidl) &&
955 PL_unify_atom_chars(A1, folderids[n].name) )
956 { PL_close_foreign_frame(fid);
957 ForeignRedoInt(n);
958 }
959 if ( PL_exception(0) )
960 PL_clear_exception();
961 PL_rewind_foreign_frame(fid);
962 }
963 PL_close_foreign_frame(fid);
964 return FALSE;
965 }
966 default:
967 succeed;
968 }
969 }
970
971
972
973 /*******************************
974 * REGISTRY *
975 *******************************/
976
977 #define wstreq(s,q) (wcscmp((s), (q)) == 0)
978
979 static HKEY
reg_open_key(const wchar_t * which,int create)980 reg_open_key(const wchar_t *which, int create)
981 { HKEY key = HKEY_CURRENT_USER;
982 DWORD disp;
983 LONG rval;
984
985 while(*which)
986 { wchar_t buf[256];
987 wchar_t *s;
988 HKEY tmp;
989
990 for(s=buf; *which && !(*which == '/' || *which == '\\'); )
991 *s++ = *which++;
992 *s = '\0';
993 if ( *which )
994 which++;
995
996 if ( wstreq(buf, L"HKEY_CLASSES_ROOT") )
997 { key = HKEY_CLASSES_ROOT;
998 continue;
999 } else if ( wstreq(buf, L"HKEY_CURRENT_USER") )
1000 { key = HKEY_CURRENT_USER;
1001 continue;
1002 } else if ( wstreq(buf, L"HKEY_LOCAL_MACHINE") )
1003 { key = HKEY_LOCAL_MACHINE;
1004 continue;
1005 } else if ( wstreq(buf, L"HKEY_USERS") )
1006 { key = HKEY_USERS;
1007 continue;
1008 }
1009
1010 DEBUG(2, Sdprintf("Trying %s\n", buf));
1011 if ( RegOpenKeyExW(key, buf, 0L, KEY_READ, &tmp) == ERROR_SUCCESS )
1012 { RegCloseKey(key);
1013 key = tmp;
1014 continue;
1015 }
1016
1017 if ( !create )
1018 return NULL;
1019
1020 rval = RegCreateKeyExW(key, buf, 0, L"", 0,
1021 KEY_ALL_ACCESS, NULL, &tmp, &disp);
1022 RegCloseKey(key);
1023 if ( rval == ERROR_SUCCESS )
1024 key = tmp;
1025 else
1026 return NULL;
1027 }
1028
1029 return key;
1030 }
1031
1032 #define MAXREGSTRLEN 1024
1033
1034 static
1035 PRED_IMPL("win_registry_get_value", 3, win_registry_get_value, 0)
1036 { GET_LD
1037 DWORD type;
1038 union
1039 { BYTE bytes[MAXREGSTRLEN];
1040 wchar_t wchars[MAXREGSTRLEN/sizeof(wchar_t)];
1041 DWORD dword;
1042 } data;
1043 DWORD len = sizeof(data);
1044 size_t klen, namlen;
1045 wchar_t *k, *name;
1046 HKEY key;
1047
1048 term_t Key = A1;
1049 term_t Name = A2;
1050 term_t Value = A3;
1051
1052 if ( !PL_get_wchars(Key, &klen, &k, CVT_ATOM|CVT_EXCEPTION) ||
1053 !PL_get_wchars(Name, &namlen, &name, CVT_ATOM|CVT_ATOM) )
1054 return FALSE;
1055 if ( !(key=reg_open_key(k, FALSE)) )
1056 return PL_error(NULL, 0, NULL, ERR_EXISTENCE, ATOM_key, Key);
1057
1058 DEBUG(9, Sdprintf("key = %p, name = %s\n", key, name));
1059 if ( RegQueryValueExW(key, name, NULL, &type, data.bytes, &len)
1060 == ERROR_SUCCESS )
1061 { RegCloseKey(key);
1062
1063 switch(type)
1064 { case REG_SZ:
1065 return PL_unify_wchars(Value, PL_ATOM,
1066 len/sizeof(wchar_t)-1, data.wchars);
1067 case REG_DWORD:
1068 return PL_unify_integer(Value, data.dword);
1069 default:
1070 warning("get_registry_value/2: Unknown registery-type: %d", type);
1071 fail;
1072 }
1073 }
1074
1075 return FALSE;
1076 }
1077
1078
1079 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1080 Get the local, global, trail and argument-stack defaults from the
1081 registry. They can be on the HKEY_CURRENT_USER as well as the
1082 HKEY_LOCAL_MACHINE registries to allow for both user-only and
1083 system-wide settings.
1084 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
1085
1086 static struct regdef
1087 { const char *name;
1088 size_t *address;
1089 } const regdefs[] =
1090 { { "stackLimit", &GD->defaults.stack_limit },
1091 { "tableSpace", &GD->defaults.table_space },
1092 { NULL, NULL }
1093 };
1094
1095
1096 static void
setStacksFromKey(HKEY key)1097 setStacksFromKey(HKEY key)
1098 { DWORD type;
1099 union
1100 { BYTE bytes[128];
1101 DWORD dword;
1102 } data;
1103 DWORD len = sizeof(data);
1104 const struct regdef *rd;
1105
1106 for(rd = regdefs; rd->name; rd++)
1107 { if ( RegQueryValueEx(key, rd->name, NULL, &type, data.bytes, &len) ==
1108 ERROR_SUCCESS &&
1109 type == REG_DWORD )
1110 { DWORD v = data.dword;
1111
1112 *rd->address = (size_t)v;
1113 }
1114 }
1115 }
1116
1117
1118 void
getDefaultsFromRegistry(void)1119 getDefaultsFromRegistry(void)
1120 { HKEY key;
1121
1122 if ( (key = reg_open_key(L"HKEY_LOCAL_MACHINE/Software/SWI/Prolog", FALSE)) )
1123 { setStacksFromKey(key);
1124 RegCloseKey(key);
1125 }
1126 if ( (key = reg_open_key(L"HKEY_CURRENT_USER/Software/SWI/Prolog", FALSE)) )
1127 { setStacksFromKey(key);
1128 RegCloseKey(key);
1129 }
1130 }
1131
1132
1133 const char *
PL_w32_running_under_wine(void)1134 PL_w32_running_under_wine(void)
1135 { static const char * (CDECL *pwine_get_version)(void);
1136 HMODULE hntdll = GetModuleHandle("ntdll.dll");
1137
1138 if ( !hntdll )
1139 { return NULL;
1140 }
1141
1142 if ( (pwine_get_version = (void *)GetProcAddress(hntdll, "wine_get_version")) )
1143 return pwine_get_version();
1144
1145 return NULL;
1146 }
1147
1148
1149 /*******************************
1150 * PUBLISH PREDICATES *
1151 *******************************/
1152
1153 BeginPredDefs(win)
1154 PRED_DEF("win_shell", 2, win_shell2, 0)
1155 PRED_DEF("win_shell", 3, win_shell3, 0)
1156 PRED_DEF("win_registry_get_value", 3, win_registry_get_value, 0)
1157 PRED_DEF("win_folder", 2, win_folder, PL_FA_NONDETERMINISTIC)
1158 PRED_DEF("win_add_dll_directory", 2, win_add_dll_directory, 0)
1159 PRED_DEF("win_remove_dll_directory", 1, win_remove_dll_directory, 0)
1160 EndPredDefs
1161
1162 #endif /*__WINDOWS__*/
1163
1164