1 /*
2
3
4 Copyright (C) 2016 Lutz Mueller
5
6 This program is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
10
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with this program. If not, see <http://www.gnu.org/licenses/>.
18
19 */
20
21 #include "newlisp.h"
22 #include <errno.h>
23 #include "protos.h"
24
25 #define AF_UNSPEC 0 /* from socket.h or winsock2.h */
26
27
28 #if defined(SOLARIS) || defined(TRU64) || defined(AIX)
29 #include <stropts.h>
30 #endif
31
32 #ifdef SOLARIS
33 #define FIONREAD I_NREAD
34 #endif
35
36 #ifndef WINDOWS
37 #include <sys/types.h>
38 #ifndef ANDROID
39 #ifndef EMSCRIPTEN
40 #include <sys/ipc.h>
41 #include <sys/sem.h>
42 #endif
43 #endif
44 #include <sys/mman.h>
45 #include <sys/ioctl.h>
46 #endif
47
48 int init_argv(char * ptr, char *argv[]);
49 char * getUUID(char * str, char * node);
50
51 #ifdef OS2
52 #include <conio.h>
53 int semctl(int semid, int semnum, int cmd, ...);
54 #endif
55
56 #if defined(LINUX) || defined(KFREEBSD)
57 union semun {
58 int val; /* Value for SETVAL */
59 struct semid_ds *buf; /* Buffer for IPC_STAT, IPC_SET */
60 unsigned short *array; /* Array for GETALL, SETALL */
61 #ifdef LINUX
62 struct seminfo *__buf; /* Buffer for IPC_INFO (Linux-specific) */
63 #endif
64 };
65 #endif /* LINUX || KFREEBSD */
66
67 #ifndef TRU64
68 extern char ** environ;
69 #endif
70
71 #ifdef WINDOWS
72 #define fgetc win_fgetc
73 #define realpath win_realpath
74 #include <conio.h>
75 #include <io.h>
76 #include <direct.h>
77 #define pclose _pclose
78 #define pipe _pipe
79
80 /*
81 Set binary as default file mode for Windows.
82 See also http://www.mingw.org/MinGWiki/index.php/binary
83 */
84 unsigned int _CRT_fmode = _O_BINARY;
85
86 int setenv (const char *name, const char *value, int replace);
87 #endif /* Win32 */
88
89 #ifndef WINDOWS
90 #include <sys/socket.h>
91 #define SOCKET_ERROR -1
92 #define INVALID_SOCKET -1
93 #endif
94
95 #if defined(LINUX) || defined(KFREEBSD) || defined(CYGWIN)
96 char * strptime(const char * str, const char * fmt, struct tm * ttm);
97 #endif
98
99 time_t calcDateValue(int year, int month, int day, int hour, int min, int sec);
100 ssize_t currentDateValue(void);
101 extern STREAM readLineStream;
102 extern FILE * IOchannel;
103 extern int pagesize;
104
105 extern char * errorMessage[];
106 extern STREAM errorStream;
107 extern UINT netErrorIdx;
108 extern int newlispLibConsoleFlag;
109
110 /* semaphore() function type */
111 #ifndef NO_SEMAPHORE
112 #define SEM_CREATE 0
113 #define SEM_STATUS 1
114 #define SEM_SIGNAL 2
115 #endif
116
117 /* used in fork and spawn */
118 int parentPid = 0;
119 /* share, message */
120 CELL * readWriteShared(UINT * address, CELL * params, int flag);
121 CELL * readWriteSocket(int socket, CELL * params);
122 CELL * readWriteSharedExpression(UINT * adress, CELL * params);
123
124 void checkDeleteShareFile(UINT * address);
125
p_isFile(CELL * params)126 CELL * p_isFile(CELL * params) /* includes dev,socket,dir,file etc. */
127 {
128 char * fileName;
129 int flag;
130
131 params = getString(params, &fileName);
132 flag = getFlag(params);
133
134 return(isFile(fileName, flag) ? nilCell : flag ? stuffString(fileName) : trueCell);
135 }
136
isFile(char * fileName,int flag)137 int isFile(char * fileName, int flag)
138 {
139 struct stat fileInfo;
140 int result;
141
142 #ifdef WINDOWS
143 char slash;
144 size_t len;
145
146 len = strlen(fileName);
147 slash = *(fileName + len - 1);
148 if((slash == '\\' || slash == '/') && (!(len >= 2 && *(fileName + len - 2) == ':')))
149 *(fileName + len - 1) = 0;
150
151 #ifdef USE_WIN_UTF16PATH
152 result = stat_utf16(fileName, &fileInfo);
153 #else
154 result = stat(fileName, &fileInfo);
155 #endif
156 if(slash == '\\' || slash == '/')
157 *(fileName + len - 1) = slash;
158 #else /* not WINDOWS */
159 result = stat(fileName, &fileInfo);
160 #endif
161 if(result == 0)
162 {
163 if(flag)
164 result = ! S_ISREG(fileInfo.st_mode);
165 }
166
167 return(result);
168 }
169
p_isDirectory(CELL * params)170 CELL * p_isDirectory(CELL * params)
171 {
172 char * fileName;
173
174 getString(params, &fileName);
175 return(isDir(fileName) ? trueCell : nilCell);
176 }
177
isDir(char * fileName)178 int isDir(char * fileName)
179 {
180 struct stat fileInfo;
181
182 #ifdef WINDOWS
183 char slash;
184 size_t len;
185
186 len = strlen(fileName);
187 slash = *(fileName + len - 1);
188 if((slash == '\\' || slash == '/') && (!(len >= 2 && *(fileName + len - 2) == ':')))
189 *(fileName + len - 1) = 0;
190 #endif
191
192 #ifdef USE_WIN_UTF16PATH
193 if(stat_utf16(fileName, &fileInfo) != 0)
194 #else
195 if(stat(fileName, &fileInfo) != 0)
196 #endif
197 {
198 #ifdef WINDOWS
199 *(fileName + len - 1) = slash;
200 #endif
201 return(0);
202 }
203
204 #ifdef WINDOWS
205 *(fileName + len - 1) = slash;
206 #endif
207
208 if(S_ISDIR(fileInfo.st_mode))
209 return(1);
210 return(0);
211 }
212
213
p_open(CELL * params)214 CELL * p_open(CELL * params)
215 {
216 char * fileName;
217 char * accessMode;
218 char * option = NULL;
219 int handle;
220 IO_SESSION * session;
221
222 params = getString(params, &fileName);
223 params = getString(params, &accessMode);
224
225 if(params != nilCell)
226 getString(params, &option);
227
228 if( (handle = openFile(fileName, accessMode, option)) == (int)-1)
229 return(nilCell);
230
231 session = createIOsession(handle, AF_UNSPEC);
232 if(*accessMode == 'r')
233 session->stream = fdopen(handle, "r");
234 else if(*accessMode == 'w')
235 session->stream = fdopen(handle, "w");
236 else if(*accessMode == 'u')
237 session->stream = fdopen(handle, "r+");
238 else if(*accessMode == 'a')
239 session->stream = fdopen(handle, "a+");
240
241 return(stuffInteger((UINT)handle));
242 }
243
p_close(CELL * params)244 CELL * p_close(CELL * params)
245 {
246 UINT handle;
247
248 getInteger(params, &handle);
249 if(handle == 0) return(nilCell);
250 if(handle == printDevice) printDevice = 0;
251 if(deleteIOsession(handle)) return(trueCell);
252 return(nilCell);
253 }
254
255
p_readChar(CELL * params)256 CELL * p_readChar(CELL * params)
257 {
258 UINT handle;
259 unsigned char chr;
260
261 if(params != nilCell)
262 getInteger(params, &handle);
263 else
264 handle = printDevice;
265
266 #ifdef WINDOWS
267 /* make it work as on Unix */
268 if(printDevice == 1 || printDevice == 2) handle = 0;
269 #endif
270
271 if(read((int)handle, &chr, 1) <= 0) return(nilCell);
272
273 return(stuffInteger((UINT)chr));
274 }
275
276
p_readBuffer(CELL * params)277 CELL * p_readBuffer(CELL * params)
278 {
279 UINT handle;
280 size_t size, length;
281 ssize_t bytesRead = 0;
282 char * waitFor;
283 STREAM stream = {NULL, NULL, 0, 0, 0};
284 CELL * strCell;
285 SYMBOL * readSptr;
286 int found = 0;
287 char chr;
288
289 params = getInteger(params, &handle);
290 params = getEvalDefault(params, &strCell);
291 if(!symbolCheck || symbolCheck->contents != (UINT)strCell)
292 return(errorProc(ERR_IS_NOT_REFERENCED));
293 if(isProtected(symbolCheck->flags))
294 return(errorProcExt2(ERR_SYMBOL_PROTECTED, stuffSymbol(symbolCheck)));
295
296 readSptr = symbolCheck;
297 params = getInteger(params, (UINT *)&size);
298
299 if(params == nilCell)
300 {
301 openStrStream(&stream, size, 0);
302 found = 1;
303 if((bytesRead = read(handle, stream.buffer, size)) == -1)
304 {
305 closeStrStream(&stream);
306 return(nilCell);
307 }
308 }
309 else
310 {
311 getString(params, &waitFor);
312 openStrStream(&stream, MAX_LINE, 0);
313 length = strlen(waitFor);
314 while(bytesRead < size)
315 {
316 if(read(handle, &chr, 1) <= 0)
317 break;
318
319 writeStreamChar(&stream, chr);
320 if(++bytesRead < length) continue;
321 if(strcmp(waitFor, stream.ptr - length) == 0)
322 {
323 found = 1;
324 break;
325 }
326 }
327 }
328
329 deleteList(strCell);
330
331 if(bytesRead == 0)
332 {
333 readSptr->contents = (UINT)copyCell(nilCell);
334 closeStrStream(&stream);
335 return(nilCell);
336 }
337
338 /*
339 #ifndef WINDOWS
340 if((fstream = getIOstream(handle)) != NULL)
341 {
342 newPosition = lseek(handle, 0, SEEK_CUR);
343 fseek(fstream, newPosition, 0);
344 }
345 #endif
346 */
347
348 if(stream.size > bytesRead)
349 stream.buffer = reallocMemory(stream.buffer, bytesRead + 1);
350 readSptr->contents = (UINT)makeStringCell(stream.buffer, bytesRead);
351
352 if(found) return(stuffInteger(bytesRead));
353 return(nilCell);
354 }
355
356
p_readFile(CELL * params)357 CELL * p_readFile(CELL * params)
358 {
359 char * fileName;
360 char * buffer = NULL;
361 ssize_t size;
362 #ifndef EMSCRIPTEN
363 CELL * result;
364 #endif
365
366 params = getString(params, &fileName);
367 #ifndef EMSCRIPTEN
368 if(my_strnicmp(fileName, "http://", 7) == 0)
369 {
370 result = getPutPostDeleteUrl(fileName, params, HTTP_GET, CONNECT_TIMEOUT);
371 return((my_strnicmp((char *)result->contents, (char *)"ERR:", 4) == 0) && netErrorIdx ? nilCell : result);
372 }
373 #endif
374 if((size = readFile(fileName, &buffer)) == -1)
375 return(nilCell);
376
377 return(makeStringCell(buffer, size));
378 }
379
380 /* allocates a buffer and reads a file into it */
readFile(char * fileName,char ** buffer)381 ssize_t readFile(char * fileName, char * * buffer)
382 {
383 int handle;
384 off_t size;
385 struct stat fileInfo;
386
387 fileName = getLocalPath(fileName);
388
389 #ifdef USE_WIN_UTF16PATH
390 if(stat_utf16(fileName, &fileInfo) != 0)
391 #else
392 if(stat(fileName, &fileInfo) != 0)
393 #endif
394 return(-1);
395
396 size = fileInfo.st_size;
397
398 if( (handle = openFile(fileName, "r", NULL)) == (int)-1)
399 return(-1);
400
401 *buffer = callocMemory(size+1);
402
403 if(read(handle, *buffer, size) == -1)
404 {
405 freeMemory(*buffer);
406 close(handle);
407 *buffer = NULL;
408 return(-1);
409 }
410
411 close(handle);
412
413 return(size);
414 }
415
416
417
p_writeChar(CELL * params)418 CELL * p_writeChar(CELL * params)
419 {
420 UINT handle;
421 UINT data;
422 size_t count;
423 unsigned char chr;
424
425 params = getInteger(params, &handle);
426 count = 0;
427
428 while(params != nilCell)
429 {
430 params = getInteger(params, &data);
431 chr = (unsigned char)data;
432 if(write((int)handle, (void *)&chr, 1) == -1)
433 return(nilCell);
434 ++count;
435 }
436
437 return(stuffInteger(count));
438 }
439
440
appendCellString(CELL * cell,char * buffer,size_t size)441 size_t appendCellString(CELL * cell, char * buffer, size_t size)
442 {
443 cell->contents = (UINT)reallocMemory((char *)cell->contents, cell->aux + size);
444 memcpy((char *)cell->contents + cell->aux - 1, buffer, size);
445 cell->aux += size;
446
447 *((char *)cell->contents + cell->aux - 1) = 0;
448
449 return(size);
450 }
451
452
p_appendFile(CELL * params)453 CELL * p_appendFile(CELL * params)
454 {
455 return(appendWriteFile(params, "a"));
456 }
457
p_writeFile(CELL * params)458 CELL * p_writeFile(CELL * params)
459 {
460 return(appendWriteFile(params, "w"));
461 }
462
writeFile(char * fileName,char * buffer,size_t size,char * type)463 int writeFile(char * fileName, char * buffer, size_t size, char * type)
464 {
465 int handle;
466
467 if( (handle = openFile(fileName, type, NULL)) == (int)-1)
468 return(-1);
469
470 if(write(handle, buffer, size) == (int)-1)
471 return(-1);
472
473 close(handle);
474 return(0);
475 }
476
appendWriteFile(CELL * params,char * type)477 CELL * appendWriteFile(CELL * params, char * type)
478 {
479 char * fileName;
480 char * buffer;
481 size_t size;
482 #ifndef EMSCRIPTEN
483 CELL * result;
484 #endif
485
486 params = getString(params, &fileName);
487
488 #ifndef EMSCRIPTEN
489 if(my_strnicmp(fileName, "http://", 7) == 0)
490 {
491 result = getPutPostDeleteUrl(fileName, params,
492 (*type == 'w') ? HTTP_PUT : HTTP_PUT_APPEND, CONNECT_TIMEOUT);
493 return((my_strnicmp((char *)result->contents, (char *)"ERR:", 4) == 0) && netErrorIdx ? nilCell : result);
494 }
495 #endif
496
497 getStringSize(params, &buffer, &size, TRUE);
498
499 if(writeFile(fileName, buffer, size, type) == (int)-1)
500 return(nilCell);
501
502 return(stuffInteger(size));
503 }
504
505 CELL * writeBuffer(CELL * params, int lineFeed);
506
p_writeBuffer(CELL * params)507 CELL * p_writeBuffer(CELL * params)
508 {
509 return(writeBuffer(params, FALSE));
510 }
511
p_writeLine(CELL * params)512 CELL * p_writeLine(CELL * params)
513 {
514 return(writeBuffer(params, TRUE));
515 }
516
517
writeBuffer(CELL * params,int lineFeed)518 CELL * writeBuffer(CELL * params, int lineFeed)
519 {
520 CELL * device;
521 UINT handle;
522 SYMBOL * symbolRef;
523 char * buffer;
524 size_t size, userSize;
525
526 if(params == nilCell)
527 {
528 varPrintf(OUT_DEVICE, "%s", readLineStream.buffer);
529 if(lineFeed) varPrintf(OUT_DEVICE, LINE_FEED);
530 size = readLineStream.ptr - readLineStream.buffer;
531 goto RETURN_WRITE_BUFFER;
532 }
533
534 params = getEvalDefault(params, &device);
535 symbolRef = symbolCheck;
536
537 if(params == nilCell)
538 {
539 buffer = readLineStream.buffer;
540 size = readLineStream.ptr - readLineStream.buffer;
541 }
542 else
543 params = getStringSize(params, &buffer, &size, TRUE);
544
545 if(!lineFeed)
546 {
547 if(params != nilCell)
548 {
549 getInteger(params, (UINT *)&userSize);
550 size = (userSize > size) ? size : userSize;
551 }
552 }
553
554 if(isNumber(device->type))
555 {
556 getIntegerExt(device, &handle, FALSE);
557 if(write((int)handle, buffer, size) == -1) return(nilCell);
558 if(lineFeed)
559 if(write((int)handle, LINE_FEED, LINE_FEED_LEN) == -1) return(nilCell);
560 }
561
562 else if(device->type == CELL_STRING)
563 {
564 if(symbolRef && isProtected(symbolRef->flags))
565 return(errorProcExt2(ERR_SYMBOL_PROTECTED, stuffSymbol(symbolRef)));
566
567 appendCellString(device, buffer, size);
568 if(lineFeed)
569 appendCellString(device, LINE_FEED, LINE_FEED_LEN);
570 }
571 else
572 return(errorProcExt(ERR_INVALID_PARAMETER, device));
573
574
575 RETURN_WRITE_BUFFER:
576 return(stuffInteger(size + (lineFeed ? LINE_FEED_LEN : 0)));
577 }
578
579
p_seek(CELL * params)580 CELL * p_seek(CELL * params)
581 {
582 UINT handle;
583 FILE * fstream;
584 #ifdef LFS
585 INT64 paramPosition;
586 off_t newPosition;
587 #else
588 off_t paramPosition;
589 off_t newPosition;
590 #endif
591
592 params = getInteger(params, &handle);
593
594 if(params == nilCell)
595 {
596 if(handle == 0)
597 newPosition = ftell(stdout);
598 else if((fstream = getIOstream(handle)) != NULL)
599 newPosition = ftell(fstream);
600 else if( (newPosition = lseek(handle, 0, SEEK_CUR)) == -1)
601 return(nilCell);
602 }
603 else
604 {
605 #ifdef LFS
606 getInteger64Ext(params, ¶mPosition, TRUE);
607 #else
608 getInteger(params, (UINT *)¶mPosition);
609 #endif
610
611 newPosition = paramPosition;
612
613 if(newPosition == -1)
614 {
615 if( (newPosition = lseek((int)handle, 0, SEEK_END)) == -1)
616 return(nilCell);
617 }
618 else
619 {
620 if( lseek((int)handle, newPosition, SEEK_SET) == -1)
621 return(nilCell);
622 }
623 }
624
625 paramPosition = newPosition;
626 #ifdef LFS
627 return(stuffInteger64(paramPosition));
628 #else
629 return(stuffInteger(paramPosition));
630 #endif
631 }
632
readStreamLine(STREAM * stream,FILE * inStream)633 char * readStreamLine(STREAM * stream, FILE * inStream)
634 {
635 #ifdef OLD_READ_STREAM /* pre 10.5.8 */
636 int chr;
637 #else
638 char buff[MAX_STRING];
639 size_t l;
640 #endif
641
642 openStrStream(stream, MAX_STRING, 1);
643
644 #ifdef TRU64
645 do {
646 errno = 0;
647 #endif
648 #ifdef TRUE64 /* pre 10.5.8 also all other OS */
649 while((chr = fgetc(inStream)) != EOF)
650 {
651 if(chr == '\n') break;
652 if(chr == '\r')
653 {
654 chr = fgetc(inStream);
655 if(chr == '\n' || chr == EOF) break;
656 }
657 writeStreamChar(stream, chr);
658 }
659 #else
660 while(fgets(buff, MAX_STRING, inStream) != NULL)
661 {
662 l=strlen(buff);
663 if(buff[l-1] == 0x0A)
664 {
665 buff[--l] = 0;
666 if(buff[l-1] == 0x0D)
667 buff[--l] = 0;
668 writeStreamStr(stream, buff, l);
669 break;
670 }
671 writeStreamStr(stream, buff, l);
672 }
673 #endif /* pre 10.5.8 also all other OS */
674 #ifdef TRU64
675 } while (errno == EINTR);
676 #endif
677
678 #ifdef TRU64 /* and pre 10.5.8 on all other OS */
679 if(chr == EOF && stream->position == 0) return(NULL);
680 #else
681 if(feof(inStream))
682 {
683 clearerr(inStream);
684 if(stream->position == 0) return(NULL);
685 }
686 #endif
687 return(stream->buffer);
688 }
689
690
p_readLine(CELL * params)691 CELL * p_readLine(CELL * params)
692 {
693 UINT handle;
694 unsigned char chr;
695 char * line;
696 int bytesRead;
697 FILE * fstream;
698
699 if(params != nilCell)
700 getInteger(params, &handle);
701 else
702 handle = printDevice;
703
704 #ifdef WINDOWS
705 /* make it work as on Unix */
706 if(printDevice == 1 || printDevice == 2) handle = 0;
707 #endif
708
709 /* check if stream input can be done */
710 fstream = (handle == 0) ? IOchannel : getIOstream(handle);
711 #ifdef LIBRARY
712 if(!newlispLibConsoleFlag && fstream == stdin)
713 return(nilCell);
714 #endif
715 if(fstream != NULL)
716 {
717 if((line = readStreamLine(&readLineStream, fstream)) == NULL)
718 return(nilCell);
719 return(stuffString(line));
720 }
721
722 /* do raw handle input, only happens when using read-line on
723 sockets on UNIX and pipes on Windows */
724 openStrStream(&readLineStream, MAX_STRING, 1);
725 while(TRUE)
726 {
727 if((bytesRead = read((int)handle, &chr, 1)) <= 0) break;
728 if(chr == '\n') break;
729 if(chr == '\r')
730 {
731 if(read((int)handle, &chr, 1) < 0) break;
732 if(chr == '\n') break;
733 }
734 writeStreamChar(&readLineStream, chr);
735 }
736
737 if(bytesRead <= 0 && readLineStream.position == 0)
738 return(nilCell);
739
740 return(stuffStringN(readLineStream.buffer, readLineStream.position));;
741 }
742
743
p_currentLine(CELL * params)744 CELL * p_currentLine(CELL * params)
745 {
746 return(stuffString(readLineStream.buffer));
747 }
748
749
getLocalPath(char * fileName)750 char * getLocalPath(char * fileName)
751 {
752 if(my_strnicmp(fileName, "file://", 7) == 0)
753 fileName = fileName + 7;
754
755 #ifdef WINDOWS
756 if(*fileName == '/' && *(fileName + 2) == ':')
757 fileName = fileName + 1;
758 #endif
759
760 return(fileName);
761 }
762
763
openFile(char * fileName,char * accessMode,char * option)764 int openFile(char * fileName, char * accessMode, char * option)
765 {
766 int blocking = 0;
767 #ifndef WINDOWS
768 int handle;
769 #endif
770
771 fileName = getLocalPath(fileName);
772
773 #ifndef WINDOWS
774 if(option != NULL && *option == 'n')
775 blocking = O_NONBLOCK;
776 #endif
777
778
779 if(*accessMode == 'r')
780 #ifdef USE_WIN_UTF16PATH
781 return(open_utf16(fileName, O_RDONLY | O_BINARY | blocking, 0));
782 #else
783 return(open(fileName, O_RDONLY | O_BINARY | blocking, 0));
784 #endif
785
786 else if(*accessMode == 'w')
787 #ifdef WINDOWS
788 #ifdef USE_WIN_UTF16PATH
789 return(open_utf16(fileName, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY, S_IREAD | S_IWRITE));
790 #else
791 return(open (fileName, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY, S_IREAD | S_IWRITE));
792 #endif /* UTF16 */
793 #else
794 return(open(fileName,O_WRONLY | O_CREAT | O_TRUNC | O_BINARY | blocking,
795 S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP | S_IWOTH)); /* rw-rw-rw */
796 #endif
797
798 else if(*accessMode == 'u')
799 return(open(fileName, O_RDWR | O_BINARY, 0));
800
801 else if(*accessMode == 'a')
802 {
803 #ifdef WINDOWS
804 #ifdef USE_WIN_UTF16PATH
805 return(open_utf16(fileName, O_RDWR | O_APPEND | O_BINARY | O_CREAT, S_IREAD | S_IWRITE));
806 #else
807 return(open(fileName, O_RDWR | O_APPEND | O_BINARY | O_CREAT, S_IREAD | S_IWRITE));
808 #endif /* UTF 16 */
809 #else
810 handle = open(fileName, O_RDWR | O_APPEND | O_BINARY | O_CREAT,
811 S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP | S_IWOTH); /* rw-rw-rw */
812 #ifdef EMSCRIPTEN
813 /* oppen append is broken on Emscripten, open for update but filepointer
814 stays at the beginning and old contents is overwritten */
815 if(lseek(handle, 0, SEEK_END) != -1)
816 return(handle);
817 #else
818 return(handle);
819 #endif
820
821 #endif
822 }
823
824 return(-1);
825 }
826
827 /* ------------------------- directory management ------------------------- */
828
p_copyFile(CELL * params)829 CELL * p_copyFile(CELL * params)
830 {
831 char * fromName;
832 char * toName;
833 int fromHandle, toHandle;
834 unsigned char * copyBuffer;
835 UINT bytesRead;
836
837 params = getString(params, &fromName);
838 getString(params, &toName);
839
840 if((fromHandle = openFile(fromName, "read", NULL)) < 0)
841 return(nilCell);
842
843 if((toHandle = openFile(toName,"write", NULL)) < 0)
844 return(nilCell);
845
846 copyBuffer = allocMemory(MAX_FILE_BUFFER);
847 do
848 {
849 bytesRead = read(fromHandle, copyBuffer, MAX_FILE_BUFFER);
850 if(write(toHandle, copyBuffer, (int)bytesRead) < 0)
851 fatalError(ERR_IO_ERROR, 0, 0);
852 } while (bytesRead == MAX_FILE_BUFFER);
853
854 free(copyBuffer);
855
856 close(fromHandle);
857 close(toHandle);
858
859 return(trueCell);
860 }
861
862
p_renameFile(CELL * params)863 CELL * p_renameFile(CELL * params)
864 {
865 char *oldName;
866 char *newName;
867
868 params = getString(params, &oldName);
869 getString(params, &newName);
870
871 #ifdef USE_WIN_UTF16PATH
872 return(rename_utf16(oldName, newName) == 0 ? trueCell : nilCell);
873 #else
874 return(rename(oldName, newName) == 0 ? trueCell : nilCell);
875 #endif
876 }
877
878
p_deleteFile(CELL * params)879 CELL * p_deleteFile(CELL * params)
880 {
881 char * fileName;
882 #ifndef EMSCRIPTEN
883 CELL * result;
884 #endif
885
886 params = getString(params, &fileName);
887 #ifndef EMSCRIPTEN
888 if(my_strnicmp(fileName, "http://", 7) == 0)
889 {
890 result = getPutPostDeleteUrl(fileName, params, HTTP_DELETE, CONNECT_TIMEOUT);
891 return((my_strnicmp((char *)result->contents, (char *)"ERR:", 4) == 0) && netErrorIdx ? nilCell : result);
892 }
893 #endif
894
895 fileName = getLocalPath(fileName);
896 #ifdef USE_WIN_UTF16PATH
897 return(unlink_utf16(fileName) == 0 ? trueCell : nilCell);
898 #else
899 return(unlink(fileName) == 0 ? trueCell : nilCell);
900 #endif
901 }
902
903
p_makeDir(CELL * params)904 CELL * p_makeDir(CELL * params)
905 {
906 char * dirString;
907 UINT mode = 0777; /* drwxrwxrwx gets user masked to drwxr-xr-x on most UNIX */
908
909 /* consume param regardless of OS */
910 params = getString(params, &dirString);
911
912 if(params != nilCell)
913 {
914 getInteger(params, &mode);
915 mode = mode > 0xfff ? 0xfff : mode;
916 }
917
918 #ifdef WINDOWS
919 #ifdef USE_WIN_UTF16PATH
920 return(mkdir_utf16(dirString) == 0 ? trueCell : nilCell);
921 #else
922 return(mkdir(dirString) == 0 ? trueCell : nilCell);
923 #endif /* UTF16 */
924 #else
925 return(mkdir(dirString, (mode_t)mode) == 0 ? trueCell : nilCell);
926 #endif
927 }
928
929
p_removeDir(CELL * params)930 CELL * p_removeDir(CELL * params)
931 {
932 char * dirString;
933
934 getString(params, &dirString);
935 #ifdef USE_WIN_UTF16PATH
936 return(rmdir_utf16(dirString) == 0 ? trueCell : nilCell);
937 #else
938 return(rmdir(dirString) == 0 ? trueCell : nilCell);
939 #endif
940 }
941
942
p_changeDir(CELL * params)943 CELL * p_changeDir(CELL * params)
944 {
945 char * newDir;
946
947 getString(params, &newDir);
948 #ifdef USE_WIN_UTF16PATH
949 return(chdir_utf16(newDir) == 0 ? trueCell : nilCell);
950 #else
951 return(chdir(newDir) == 0 ? trueCell : nilCell);
952 #endif
953 }
954
p_directory(CELL * params)955 CELL * p_directory(CELL * params)
956 {
957 CELL * dirList;
958 char * dirPath;
959 char * fileName;
960 char * pattern = NULL;
961 INT options = 0;
962 DIR * dir;
963 struct dirent * dEnt;
964
965 if(params != nilCell)
966 {
967 params = getString(params, &dirPath);
968 if(params != nilCell)
969 {
970 params = getString(params, &pattern);
971 if(params != nilCell)
972 /* 10.6.1 also accept string for options */
973 parseRegexOptions(params, (UINT *)&options, TRUE);
974 }
975 }
976 else dirPath = ".";
977
978 dirList = getCell(CELL_EXPRESSION);
979
980 dir = opendir(dirPath);
981 if(dir == NULL) return(nilCell);
982
983 while((dEnt = readdir(dir)) != NULL)
984 {
985 #ifdef USE_WIN_UTF16PATH
986 fileName = utf16_to_utf8(dEnt->d_name);
987 #else
988 fileName = dEnt->d_name;
989 #endif
990 if(!pattern || searchBufferRegex(fileName, 0, pattern, strlen(fileName), options, NULL) != -1)
991 addList(dirList, stuffString(fileName));
992 #ifdef USE_WIN_UTF16PATH
993 free(fileName);
994 #endif
995 }
996
997 closedir(dir);
998 return(dirList);
999 }
1000
1001
1002 #define DOT_PATH ".\000"
1003
1004
p_realpath(CELL * params)1005 CELL * p_realpath(CELL * params)
1006 {
1007 char path[PATH_MAX];
1008 char * name;
1009
1010 if(params != nilCell)
1011 {
1012 params = getString(params, &name);
1013 if(getFlag(params))
1014 {
1015 if((name = which(name, alloca(PATH_MAX))) == NULL)
1016 return(nilCell);
1017 return(stuffString(name));
1018 }
1019 }
1020 else name = DOT_PATH;
1021
1022 if(realpath(name, path) == NULL)
1023 return(nilCell);
1024
1025 #ifdef _BSD /* behaves like Windows */
1026 if(isFile(path, 0)) return(nilCell);
1027 #endif
1028
1029 return(stuffString(path));
1030 }
1031
p_fileInfo(CELL * params)1032 CELL * p_fileInfo(CELL * params)
1033 {
1034 char * pathName;
1035 struct stat fileInfo;
1036 CELL * list;
1037 int result = 0;
1038
1039 params = getString(params, &pathName);
1040
1041 #ifdef WINDOWS /* has no link-flag */
1042 #ifdef USE_WIN_UTF16PATH
1043 result = stat_utf16(pathName, &fileInfo);
1044 #else
1045 result = stat(pathName, &fileInfo);
1046 #endif
1047
1048 #else /* Unix */
1049 if(getFlag(params->next))
1050 result = stat(pathName, &fileInfo);
1051 else
1052 result = lstat(pathName, &fileInfo);
1053 #endif
1054
1055 if(result != 0)
1056 return(nilCell);
1057
1058 list = stuffIntegerList(
1059 8,
1060 (UINT)fileInfo.st_size,
1061 (UINT)fileInfo.st_mode,
1062 (UINT)fileInfo.st_rdev,
1063 (UINT)fileInfo.st_uid,
1064 (UINT)fileInfo.st_gid,
1065 (UINT)fileInfo.st_atime,
1066 (UINT)fileInfo.st_mtime,
1067 (UINT)fileInfo.st_ctime
1068 );
1069
1070 #ifndef NEWLISP64
1071 #ifdef LFS
1072 ((CELL *)list->contents)->type = CELL_INT64;
1073 *(INT64 *)&((CELL *)list->contents)->aux = (INT64)fileInfo.st_size;
1074 #endif /* LFS */
1075 #endif /* NEWLISP64 */
1076
1077 if(params != nilCell)
1078 {
1079 pushResult(list);
1080 return(copyCell(implicitIndexList(list, params)));
1081 }
1082
1083 return(list);
1084 }
1085
1086
1087 #ifdef LFS
fileSize(char * pathName)1088 INT64 fileSize(char * pathName)
1089 #else
1090 size_t fileSize(char * pathName)
1091 #endif
1092 {
1093 struct stat fileInfo;
1094 int result;
1095
1096 #ifdef WINDOWS /* has no link-flag */
1097 #ifdef USE_WIN_UTF16PATH
1098 result = stat_utf16(pathName, &fileInfo);
1099 #else
1100 result = stat(pathName, &fileInfo);
1101 #endif
1102 #else /* Unix */
1103 result = stat(pathName, &fileInfo);
1104 #endif
1105
1106 if(result != 0) return 0;
1107
1108 return(fileInfo.st_size);
1109 }
1110
1111
1112 /* ------------------------- processes and pipes ------------------------- */
1113
1114 #ifndef WINDOWS
p_system(CELL * params)1115 CELL * p_system(CELL *params)
1116 {
1117 char * command;
1118 getString(params, &command);
1119 return(stuffInteger((UINT)system(command)));
1120 }
1121 #else
p_system(CELL * params)1122 CELL * p_system(CELL *params)
1123 {
1124 UINT creation_flags = 0;
1125 char * command;
1126 STARTUPINFO si;
1127 PROCESS_INFORMATION pi;
1128 UINT result;
1129
1130 memset(&si, 0, sizeof(STARTUPINFO));
1131 memset(&pi, 0, sizeof(PROCESS_INFORMATION));
1132
1133 si.cb = sizeof(STARTUPINFO);
1134
1135 params = getString(params, &command);
1136 if(params != nilCell)
1137 getInteger(params, &creation_flags);
1138 else
1139 return(stuffInteger((UINT)system(command)));
1140
1141 result = CreateProcessA(NULL, command, NULL, NULL, 0, (DWORD)creation_flags, NULL, NULL,
1142 (LPSTARTUPINFO)&si, (LPPROCESS_INFORMATION)&pi);
1143
1144
1145 if(!result) return(nilCell);
1146
1147 WaitForSingleObject(pi.hProcess, -1);
1148 CloseHandle(pi.hProcess);
1149 CloseHandle(pi.hThread);
1150
1151 return(stuffInteger(result));
1152 }
1153 #endif
1154
1155
p_exec(CELL * params)1156 CELL * p_exec(CELL * params)
1157 {
1158 CELL * lineList;
1159 char * line;
1160 char * command, * data;
1161 FILE * handle;
1162 size_t size;
1163
1164 params = getString(params, &command);
1165 if(params == nilCell)
1166 {
1167 if((handle = popen(command , "r")) == NULL)
1168 return(nilCell);
1169
1170 lineList = getCell(CELL_EXPRESSION);
1171 while((line = readStreamLine(&readLineStream, handle)) != NULL)
1172 addList(lineList, stuffString(line));
1173
1174 pclose(handle);
1175 return(lineList);
1176 }
1177
1178 getStringSize(params, &data, &size, TRUE);
1179
1180 if((handle = popen(command, "w")) == NULL)
1181 return(nilCell);
1182
1183 if(fwrite(data, 1, (size_t)size, handle) < size)
1184 return(nilCell);
1185
1186 pclose(handle);
1187 return(trueCell);
1188 }
1189
1190
1191 /* parses/splits a string intor substrings separated
1192 by spaces, strings containing spaces can be enclosed
1193 in either a pair of single or double quotes
1194 */
init_argv(char * ptr,char * argv[])1195 int init_argv(char * ptr, char *argv[])
1196 {
1197 int argc = 0;
1198 char brkChr;
1199
1200 while(*ptr != 0)
1201 {
1202 while(*ptr == ' ') ++ptr;
1203 if(*ptr == 0) break;
1204 if(*ptr == '\'' || *ptr == '"')
1205 {
1206 brkChr = *ptr;
1207 argv[argc++] = ++ptr;
1208 while(*ptr != brkChr && *ptr != 0) ++ptr;
1209 if(*ptr == 0) break;
1210 *ptr++ = 0;
1211 continue;
1212 }
1213 else
1214 {
1215 argv[argc++] = ptr++;
1216 while(*ptr != ' ' && *ptr != 0) ptr++;
1217 if(*ptr == 0) break;
1218 *ptr++ = 0;
1219 }
1220 }
1221
1222 argv[argc] = 0;
1223 return(argc);
1224 }
1225
1226
1227 #ifndef EMSCRIPTEN
1228 #ifdef WINDOWS
1229 int kill(pid_t pid, int sig);
1230 int winPipe(UINT * inpipe, UINT * outpipe);
1231 UINT winPipedProcess(char * command, int inpipe, int outpipe, int option);
1232 UINT plainProcess(char * command, size_t size);
1233
p_pipe(CELL * params)1234 CELL * p_pipe(CELL * params)
1235 {
1236 UINT hin, hout;
1237 IO_SESSION * session;
1238
1239 if(!winPipe(&hin, &hout)) /* see file win-util.c */
1240 return(nilCell);
1241
1242 session = createIOsession(hin, AF_UNSPEC);
1243 session->stream = fdopen(hin, "r");
1244 session = createIOsession(hout, AF_UNSPEC);
1245 session->stream = fdopen(hout, "w");
1246
1247 return(stuffIntegerList(2, hin, hout));
1248 }
1249
1250
p_process(CELL * params)1251 CELL * p_process(CELL * params)
1252 {
1253 char * command;
1254 int result;
1255 size_t size;
1256
1257 UINT inpipe = 0, outpipe = 0, option = 1;
1258
1259 params = getStringSize(params, &command, &size, TRUE);
1260 if(params != nilCell)
1261 {
1262 params = getInteger(params, (UINT *)&inpipe);
1263 params = getInteger(params, (UINT *)&outpipe);
1264 if(params != nilCell)
1265 getInteger(params, (UINT *)&option);
1266 result = winPipedProcess(command, (int)inpipe, (int)outpipe, (int)option);
1267 }
1268 else result = plainProcess(command, size);
1269
1270 if(!result) return(nilCell);
1271
1272 return(stuffInteger(result));
1273 }
1274
1275
1276 #else /* not WINDOWS */
1277
p_pipe(CELL * params)1278 CELL * p_pipe(CELL * params)
1279 {
1280 int handles[2];
1281 #ifndef SUNOS
1282 IO_SESSION * session;
1283 #endif
1284
1285 if(pipe(handles) != 0)
1286 return(nilCell);
1287
1288 #ifndef SUNOS
1289 session = createIOsession(handles[0], AF_UNSPEC);
1290 session->stream = fdopen(handles[0], "r");
1291 session = createIOsession(handles[1], AF_UNSPEC);
1292 session->stream = fdopen(handles[0], "w");
1293 #endif
1294
1295 return(stuffIntegerList(2, (UINT)handles[0], (UINT)handles[1]));
1296 }
1297
1298
p_process(CELL * params)1299 CELL * p_process(CELL * params)
1300 {
1301 char * command;
1302 char * cmd;
1303 int forkResult;
1304 UINT inpipe = 0, outpipe = 0, errpipe = 0;
1305 char * argv[16];
1306 size_t size;
1307
1308 params = getStringSize(params, &command, &size, TRUE);
1309 cmd = callocMemory(size + 1);
1310 memcpy(cmd, command, size + 1);
1311
1312 #ifdef DEBUG_INIT_ARGV
1313 int i;
1314 init_argv(cmd, argv);
1315 for(i = 0; i < 15; i++)
1316 {
1317 if(argv[i] == NULL) break;
1318 printf("->%s<-\n", argv[i]);
1319 }
1320 return(trueCell);
1321 #endif
1322
1323 if(params != nilCell)
1324 {
1325 params = getInteger(params, (UINT *)&inpipe);
1326 params = getInteger(params, (UINT *)&outpipe);
1327 if(params != nilCell)
1328 getInteger(params, (UINT *)&errpipe);
1329 }
1330
1331 if((forkResult = fork()) == -1)
1332 return(nilCell);
1333 if(forkResult == 0)
1334 {
1335 /* redirect stdin and stdout, stderr to pipe handles */
1336 if(inpipe)
1337 {
1338 close(STDIN_FILENO);
1339 if(dup2((int)inpipe, STDIN_FILENO) == -1) exit(0);
1340 close((int)inpipe);
1341 }
1342 if(outpipe)
1343 {
1344 close(STDOUT_FILENO);
1345 if(dup2((int)outpipe, STDOUT_FILENO) == -1) exit(0);
1346 if(!errpipe)
1347 if(dup2((int)outpipe, STDERR_FILENO) == -1) exit(0);
1348 close((int)outpipe);
1349 }
1350 if(errpipe)
1351 {
1352 close(STDERR_FILENO);
1353 if(dup2((int)errpipe, STDERR_FILENO) == -1) exit(0);
1354 close((int)errpipe);
1355 }
1356
1357 init_argv(cmd, argv);
1358
1359 execve(argv[0], argv, environ);
1360 exit(0);
1361 }
1362
1363 freeMemory(cmd);
1364
1365 return(stuffInteger(forkResult));
1366 }
1367
1368 #ifndef NO_FORK
p_fork(CELL * params)1369 CELL * p_fork(CELL * params)
1370 {
1371 int forkResult;
1372 int ppid = getpid();
1373
1374 if((forkResult = fork()) == -1)
1375 return(nilCell);
1376 if(forkResult == 0)
1377 {
1378 parentPid = ppid;
1379 evaluateExpression(params);
1380 exit(0);
1381 }
1382
1383 return(stuffInteger(forkResult));
1384 }
1385 #endif
1386
1387 /* ------------------------------------------------------------------------- */
1388
1389
1390 /* Cilk like interface for spawning and syncronizing child processes
1391 spawn - start child
1392 sync - syncronize results
1393 abort - abort child
1394
1395 message - share data with chold and parent
1396 */
1397
1398 /* run with or without semaphores */
1399
1400 void * parentPad = NULL; /* written by parent for this process */
1401 void * thisPad = NULL; /* written by this process for the parent */
1402 int thisSocket = 0;
1403 fd_set myFdSet; /* set of all child sockets */
1404
1405
1406 #ifndef NO_SPAWN
1407
1408 typedef struct
1409 {
1410 void * result_addr; /* written by child */
1411 SYMBOL * symbolPtr; /* smbol for result */
1412 int pid; /* childs pid */
1413 int socket;
1414 void * next;
1415 } SPAWN_LIST;
1416
1417 SPAWN_LIST * mySpawnList = NULL;
1418
addSpawnedChild(void * addr,SYMBOL * sPtr,int pid,int socket)1419 void addSpawnedChild(void * addr, SYMBOL * sPtr, int pid, int socket)
1420 {
1421 SPAWN_LIST * spawnList;
1422
1423 spawnList = (SPAWN_LIST *)allocMemory(sizeof(SPAWN_LIST));
1424
1425 spawnList->result_addr = addr;
1426 spawnList->symbolPtr = sPtr;
1427 spawnList->pid = pid;
1428 spawnList->socket = socket;
1429 spawnList->next = NULL;
1430
1431 if(mySpawnList == NULL)
1432 mySpawnList = spawnList;
1433 else/* insert in front */
1434 {
1435 spawnList->next = mySpawnList;
1436 mySpawnList = spawnList;
1437 }
1438 }
1439
1440
getSpawnedChild(int pid)1441 SPAWN_LIST * getSpawnedChild(int pid)
1442 {
1443 SPAWN_LIST * spawnList = mySpawnList;
1444
1445 while(spawnList != NULL)
1446 {
1447 if(spawnList->pid == pid) break;
1448 spawnList = spawnList->next;
1449 }
1450
1451 return(spawnList);
1452 }
1453
purgeSpawnList(int sockFlag)1454 void purgeSpawnList(int sockFlag)
1455 {
1456 SPAWN_LIST * spawnList;
1457
1458 /* pop and delete entries */
1459
1460 while(mySpawnList != NULL)
1461 {
1462 if(sockFlag)
1463 close(mySpawnList->socket);
1464 spawnList = mySpawnList->next;
1465 free(mySpawnList);
1466 mySpawnList = spawnList;
1467 }
1468 }
1469
1470 /* lookup pid get result from shared memory and delete entry */
1471
1472 #define PROCESS_SPAWN_RESULT 0
1473 #define PROCESS_SPAWN_ABORT 1
1474 #define PROCESS_SPAWN_ABNORMAL_END 2
1475 #define ABEND "ERR: abnormal process end"
1476
processSpawnList(int pid,int mode,int result)1477 void processSpawnList(int pid, int mode, int result)
1478 {
1479 SPAWN_LIST * pidSpawn;
1480 SPAWN_LIST * previousSpawn;
1481 CELL * cell;
1482 SYMBOL * sPtr;
1483 char str[32];
1484
1485 pidSpawn = previousSpawn = mySpawnList;
1486
1487 while(pidSpawn)
1488 {
1489 if(pidSpawn->pid == pid)
1490 {
1491 if(pidSpawn == mySpawnList)
1492 mySpawnList = pidSpawn->next;
1493 else
1494 previousSpawn->next = pidSpawn->next;
1495
1496 if(mode == PROCESS_SPAWN_RESULT)
1497 {
1498 cell = readWriteShared(pidSpawn->result_addr, nilCell, 0);
1499 sPtr = pidSpawn->symbolPtr;
1500 deleteList((CELL *)sPtr->contents);
1501 sPtr->contents = (UINT)cell;
1502 }
1503 else if(mode == PROCESS_SPAWN_ABORT)
1504 {
1505 FD_CLR(pidSpawn->socket, &myFdSet);
1506 kill(pidSpawn->pid, 9);
1507 waitpid(pidSpawn->pid, (int *)0, 0);
1508 }
1509 else /* PROCESS_SPAWN_ABNORMAL_END */
1510 {
1511 sPtr = pidSpawn->symbolPtr;
1512 deleteList((CELL *)sPtr->contents);
1513 snprintf(str, 32, "%s %d", ABEND, result);
1514 sPtr->contents = (UINT)stuffString(str);
1515 }
1516
1517 /* close parent socket */
1518 if(pidSpawn->socket) close(pidSpawn->socket);
1519 checkDeleteShareFile(pidSpawn->result_addr);
1520 /* unmap shared result memory */
1521 munmap(pidSpawn->result_addr, pagesize);
1522 free((char *)pidSpawn);
1523 break;
1524 }
1525 previousSpawn = pidSpawn;
1526 pidSpawn = pidSpawn->next;
1527 }
1528 }
1529
1530 /* spawn (fork) a process and assign result to the symbol given
1531 (spawn <quoted-symbol> <epxression>) => pid
1532 creates a memory share and passes it to the spawned process
1533 when the spawned child finishes, it copies the result
1534 to the memory share. If the result does not fit in the pagesize
1535 store the result in a file with a unique filename which is
1536 stored in the memory share. The first int32 word is -1 for
1537 memshare store or 0 for file store.
1538 For house keeping purpose SPAWN_LIST is maintained to find
1539 the memshare adddress from the child pid.
1540 */
p_spawn(CELL * params)1541 CELL * p_spawn(CELL * params)
1542 {
1543 int forkPid;
1544 int pid;
1545 void * address; /* share memory area for result */
1546 SYMBOL * symPtr;
1547 int sockets[2] = {0, 0};
1548
1549 if((address = mmap( 0, pagesize,
1550 PROT_READ | PROT_WRITE, MAP_SHARED | MAP_ANON, -1, 0)) == (void*)-1)
1551 return(nilCell);
1552
1553 memset(address, 0, sizeof(INT));
1554
1555 params = getSymbol(params, &symPtr);
1556 if(isProtected(symPtr->flags))
1557 return(errorProcExt2(ERR_SYMBOL_PROTECTED, stuffSymbol(symPtr)));
1558 deleteList((CELL *)symPtr->contents);
1559 symPtr->contents = (UINT)nilCell;
1560
1561 pid = getpid();
1562
1563 /* socketpair for send/receive API is optional */
1564 if(getFlag(params->next))
1565 {
1566 if (socketpair(AF_UNIX, SOCK_STREAM, 0, sockets) == -1)
1567 {
1568 munmap(address, pagesize);
1569 return(errorProc(ERR_CANNOT_OPEN_SOCKETPAIR));
1570 }
1571
1572 /* add the parent socket to myFdSet */
1573 if(mySpawnList == NULL)
1574 FD_ZERO(&myFdSet);
1575 FD_SET(sockets[0], &myFdSet);
1576 }
1577
1578 /* make signals processable by waitpid() in p_sync() */
1579 signal(SIGCHLD, SIG_DFL);
1580
1581 if((forkPid = fork()) == -1)
1582 {
1583 if(sockets[0]) close(sockets[0]);
1584 if(sockets[1]) close(sockets[1]);
1585 munmap(address, pagesize);
1586 return(nilCell);
1587 }
1588
1589 if(forkPid == 0) /* the child process */
1590 {
1591 /* seed random generator for message fail delay */
1592 srandom(getpid());
1593 /* get parent pid */
1594 parentPid = pid;
1595 if(sockets[0]) close(sockets[0]);
1596 thisSocket = sockets[1];
1597 /* purge inherited spawnlist */
1598 purgeSpawnList(FALSE);
1599 /* evaluate and write result to shared memory */
1600 readWriteShared(address, params, TRUE);
1601 /* close child socket */
1602 if(thisSocket) close(thisSocket);
1603 exit(0);
1604 }
1605
1606 if(sockets[1]) close(sockets[1]);
1607 addSpawnedChild(address, symPtr, forkPid, sockets[0]);
1608
1609 return(stuffInteger(forkPid));
1610 }
1611
1612 /* wait for spawned processes to finish for the timeout specified:
1613 (sync <timeout-milli-seconds>) => true
1614 if no timeout is not specified only return a list of pending
1615 child pids:
1616 (sync) => list of pids
1617 For each finished child get the result and assign it to the
1618 symbol looked up in SPAWN_LIST.
1619 */
p_sync(CELL * params)1620 CELL * p_sync(CELL * params)
1621 {
1622 int result;
1623 int pid;
1624 UINT timeout = 0;
1625 struct timeval tv, tp;
1626 SPAWN_LIST * spawnList;
1627 CELL * resultList = getCell(CELL_EXPRESSION);
1628 int inletFlag = 0;
1629 UINT * resultIdxSave;
1630 CELL * cell;
1631
1632 if(mySpawnList == NULL)
1633 return(resultList); /* nothing pending */
1634
1635 if(params == nilCell)
1636 {
1637 spawnList = mySpawnList;
1638 while(spawnList != NULL)
1639 {
1640 addList(resultList, stuffInteger(spawnList->pid));
1641 spawnList = spawnList->next;
1642 }
1643 return(resultList);
1644 }
1645
1646 deleteList(resultList);
1647
1648 params = getInteger(params, &timeout);
1649 if(params == nilCell || isNil((CELL *)((SYMBOL *)params->contents)->contents))
1650 signal(SIGCHLD, SIG_DFL);
1651 else
1652 inletFlag = TRUE;
1653
1654 gettimeofday(&tv, NULL);
1655
1656 while(mySpawnList != NULL)
1657 {
1658 gettimeofday(&tp, NULL);
1659 if(timediff_ms(tp, tv) > timeout) return(nilCell);
1660 /* wait for any child process to finish */
1661 pid = waitpid(-1, &result, WNOHANG);
1662 if(pid)
1663 {
1664 if(!WIFEXITED(result))
1665 processSpawnList(pid, PROCESS_SPAWN_ABNORMAL_END, result);
1666 else
1667 processSpawnList(pid, PROCESS_SPAWN_RESULT, 0);
1668 if(inletFlag)
1669 {
1670 resultIdxSave = resultStackIdx;
1671 pushResult(cell = makeCell(CELL_EXPRESSION, (UINT)copyCell(params)));
1672 ((CELL *)cell->contents)->next = stuffInteger((UINT)pid);
1673 evaluateExpression(cell);
1674 cleanupResults(resultIdxSave);
1675 }
1676 }
1677 }
1678
1679 /* put initial behaviour back */
1680 #if defined(SOLARIS) || defined(TRU64) || defined(AIX)
1681 setupSignalHandler(SIGCHLD, sigchld_handler);
1682 #else
1683 setupSignalHandler(SIGCHLD, signal_handler);
1684 #endif
1685
1686 return(trueCell);
1687 }
1688
1689 /* if abort a specific pid if specified:
1690 (abort <pid>)
1691 or abort all:
1692 (abort)
1693 */
1694
p_abort(CELL * params)1695 CELL * p_abort(CELL * params)
1696 {
1697 UINT pid;
1698
1699 if(params != nilCell)
1700 {
1701 getInteger(params, &pid);
1702 processSpawnList(pid, PROCESS_SPAWN_ABORT, 0);
1703 }
1704 else /* abort all */
1705 {
1706 while(mySpawnList != NULL)
1707 processSpawnList(mySpawnList->pid, PROCESS_SPAWN_ABORT, 0);
1708 /* put initial behaviour back */
1709 #if defined(SOLARIS) || defined(TRU64) || defined(AIX)
1710 setupSignalHandler(SIGCHLD, sigchld_handler);
1711 #else
1712 setupSignalHandler(SIGCHLD, signal_handler);
1713 #endif
1714 }
1715
1716 return(trueCell);
1717 }
1718
1719 #define SELECT_READ_READY 0
1720 #define SELECT_WRITE_READY 1
1721
getSelectReadyList(int mode)1722 CELL * getSelectReadyList(int mode)
1723 {
1724 CELL * pidList = getCell(CELL_EXPRESSION);
1725 SPAWN_LIST * child;
1726 int ready = 0;
1727 struct timeval tv;
1728 fd_set thisFdSet;
1729
1730 tv.tv_sec = 0;
1731 tv.tv_usec = 892 + random() / 10000000;
1732
1733 #if defined(SUNOS) || defined(LINUX) || defined(CYGWIN) || defined(AIX) || defined(KFREEBSD)
1734 memcpy(&thisFdSet, &myFdSet, sizeof(fd_set));
1735 #else
1736 FD_COPY(&myFdSet, &thisFdSet);
1737 #endif
1738
1739 if(mode == SELECT_READ_READY)
1740 ready = select(FD_SETSIZE, &thisFdSet, NULL, NULL, &tv);
1741 else /* SELECT_WRITE_READY */
1742 ready = select(FD_SETSIZE, NULL, &thisFdSet, NULL, &tv);
1743
1744 if(ready == 0) return(pidList);
1745
1746 if(ready < 0)
1747 return(pidList);
1748
1749 child = mySpawnList;
1750 while (child != NULL)
1751 {
1752 if(FD_ISSET(child->socket, &thisFdSet))
1753 addList(pidList, stuffInteger(child->pid));
1754 child = child->next;
1755 }
1756
1757 return(pidList);
1758 }
1759
1760
p_send(CELL * params)1761 CELL * p_send(CELL * params)
1762 {
1763 UINT pid;
1764 CELL * result = nilCell;
1765 SPAWN_LIST * child = NULL;
1766 int socket;
1767
1768 /* return list of writable child pids */
1769 if(params == nilCell)
1770 return(getSelectReadyList(SELECT_WRITE_READY));
1771
1772 params = getInteger(params, &pid);
1773
1774 if(pid == parentPid) /* write to parent */
1775 {
1776 socket = thisSocket;
1777 }
1778 else /* write to child */
1779 {
1780 if((child = getSpawnedChild(pid)) == NULL)
1781 errorProcExt2(ERR_INVALID_PID, stuffInteger(pid));
1782 socket = child->socket;
1783 }
1784
1785 if(!socket)
1786 errorProc(ERR_NO_SOCKET);
1787
1788 if(params == nilCell)
1789 errorProc(ERR_MISSING_ARGUMENT);
1790
1791 result = readWriteSocket(socket, params);
1792
1793 return(result);
1794 }
1795
1796
p_receive(CELL * params)1797 CELL * p_receive(CELL * params)
1798 {
1799 UINT pid;
1800 CELL * cell;
1801 SPAWN_LIST * child = NULL;
1802 SYMBOL * sPtr = NULL;
1803 int socket;
1804
1805 /* return list of readable child pids */
1806 if(params == nilCell)
1807 return(getSelectReadyList(SELECT_READ_READY));
1808
1809 params = getInteger(params, &pid);
1810
1811 if(params != nilCell)
1812 {
1813 getEvalDefault(params, &cell);
1814 if(!symbolCheck)
1815 return(errorProc(ERR_IS_NOT_REFERENCED));
1816 if(isProtected(symbolCheck->flags))
1817 return(errorProcExt2(ERR_SYMBOL_PROTECTED, stuffSymbol(symbolCheck)));
1818 if(symbolCheck->contents != (UINT)cell)
1819 return(errorProc(ERR_IS_NOT_REFERENCED));
1820 sPtr = symbolCheck;
1821 }
1822
1823 /* read from parent */
1824 if(pid == parentPid)
1825 {
1826 socket = thisSocket;
1827 }
1828 else /* read from child */
1829 {
1830 if((child = getSpawnedChild(pid)) == NULL)
1831 errorProcExt2(ERR_INVALID_PID, stuffInteger(pid));
1832 socket = child->socket;
1833 }
1834
1835 if(!socket)
1836 errorProc(ERR_NO_SOCKET);
1837
1838 cell = readWriteSocket(socket, nilCell);
1839 if(cell == nilCell)
1840 return(nilCell);
1841
1842 /* if no msg variable is given make message the return value */
1843 if(sPtr == NULL)
1844 return(cell);
1845
1846 deleteList((CELL *)sPtr->contents);
1847 sPtr->contents = (UINT)cell;
1848 pushResultFlag = FALSE;
1849
1850 return(trueCell);
1851 }
1852
1853
1854 /* evaluate expression in params and write to socket,
1855 part of a socket pair. Similar to readWriteShare()
1856 but uses sockets instead od shared memory */
1857
readWriteSocket(int socket,CELL * params)1858 CELL * readWriteSocket(int socket, CELL * params)
1859 {
1860 char * buffer;
1861 CELL * cell;
1862 STREAM strStream = {NULL, NULL, 0, 0, 0};
1863 UINT length;
1864 ssize_t size, bytesReceived;
1865 struct timeval tv;
1866 fd_set fdset;
1867 int ready;
1868
1869 tv.tv_sec = 0;
1870 tv.tv_usec = 892 + random()/10000000;
1871
1872 FD_ZERO(&fdset);
1873 FD_SET(socket, &fdset);
1874
1875 if(params != nilCell) /* send message, write */
1876 {
1877 /* ready = select(socket, NULL, &fdset, NULL, &tv); */
1878 ready = select(FD_SETSIZE, NULL, &fdset, NULL, &tv);
1879 /* ready = FD_ISSET(socket, &fdset) */
1880 if(ready == 1)
1881 {
1882 cell = evaluateExpression(params);
1883 if(cell->type == CELL_EXPRESSION)
1884 size = 128;
1885 else
1886 size = 32;
1887 openStrStream(&strStream, size, 0);
1888 prettyPrintFlags |= PRETTYPRINT_STRING;
1889 printCell(cell , TRUE, (UINT)&strStream);
1890 prettyPrintFlags &= ~PRETTYPRINT_STRING;
1891 length = strStream.position;
1892 if(send(socket, &length, sizeof(UINT), 0) == sizeof(UINT))
1893 {
1894 size = send(socket, strStream.buffer, strStream.position, 0);
1895 if(size == strStream.position)
1896 {
1897 closeStrStream(&strStream);
1898 return(trueCell);
1899 }
1900 /* caller should check errno using (sys-error) */
1901 closeStrStream(&strStream);
1902 return(nilCell);
1903 }
1904 }
1905 else
1906 {
1907 /* timeout, socket not ready */
1908 return(nilCell);
1909 }
1910 }
1911 /* receive message, read */
1912 /* ready = select(socket, &fdset, NULL, NULL, &tv); */
1913 ready = select(FD_SETSIZE, &fdset, NULL, NULL, &tv);
1914 /* ready = FD_ISSET(socket, &fdset) */
1915 if(ready == 1)
1916 {
1917 if((size = recv(socket, &length, sizeof(UINT), 0)) == sizeof(UINT))
1918 {
1919 buffer = callocMemory(length + 1);
1920 bytesReceived = 0;
1921 while(bytesReceived < length)
1922 {
1923 size = recv(socket, buffer + bytesReceived, length - bytesReceived, 0);
1924 if(size == -1)
1925 {
1926 free(buffer);
1927 return(nilCell);
1928 }
1929 bytesReceived += size;
1930 }
1931 cell = sysEvalString(buffer, currentContext, nilCell, READ_EXPR_SYNC);
1932 free(buffer);
1933 return(cell);
1934 }
1935 }
1936
1937 return(nilCell);
1938 }
1939
1940 #endif /* NO_SPAWN */
1941
1942 /* --------------------------- end Cilk ------------------------------------- */
1943
1944
1945 extern SYMBOL * symHandler[];
1946
p_waitpid(CELL * params)1947 CELL * p_waitpid(CELL * params)
1948 {
1949 UINT pid, options;
1950 int result, retval;
1951
1952 symHandler[SIGCHLD - 1] = nilSymbol;
1953 signal(SIGCHLD, SIG_DFL);
1954
1955 params = getInteger(params, (UINT *)&pid);
1956 if(params != nilCell)
1957 {
1958 params = evaluateExpression(params);
1959 if(isNil(params))
1960 options = WNOHANG;
1961 else
1962 getIntegerExt(params, (UINT *)&options, FALSE);
1963 }
1964 else
1965 options = 0;
1966
1967 retval = waitpid((int)pid, &result , (int)options);
1968
1969 return(stuffIntegerList(2, (UINT)retval, (UINT)result));
1970 }
1971
1972 #endif
1973
p_destroyProcess(CELL * params)1974 CELL * p_destroyProcess(CELL * params)
1975 {
1976 UINT pid;
1977 UINT sig;
1978
1979 params = getInteger(params, &pid);
1980 if(params != nilCell)
1981 getInteger(params, &sig);
1982 else
1983 sig = 9;
1984
1985 if(kill(pid, sig) != 0)
1986 return(nilCell);
1987
1988 return(trueCell);
1989 }
1990
1991 /* ------------------------------ semaphores --------------------------------- */
1992 #ifndef NO_SEMAPHORE
1993 #ifdef WINDOWS
1994
1995 UINT winCreateSemaphore(void);
1996 UINT winWaitSemaphore(UINT hSemaphore);
1997 UINT winSignalSemaphore(UINT hSemaphore, int count);
1998 UINT winDeleteSemaphore(UINT hSemaphore);
1999 int getSemaphoreCount(UINT hSemaphore);
2000
p_semaphore(CELL * params)2001 CELL * p_semaphore(CELL * params)
2002 {
2003 UINT sem_id;
2004 INT value;
2005
2006 if(params != nilCell)
2007 {
2008 params = getInteger(params, &sem_id);
2009 if(params != nilCell)
2010 {
2011 getInteger(params,(UINT *)&value);
2012 if(value == 0)
2013 {
2014 if(!winDeleteSemaphore(sem_id))
2015 return(nilCell);
2016 return(trueCell);
2017 }
2018
2019 /* wait or signal */
2020 if(value < 0)
2021 {
2022 if(winWaitSemaphore(sem_id)) return(trueCell);
2023 return(nilCell);
2024 }
2025 if(value > 0)
2026 {
2027 if(winSignalSemaphore(sem_id, value)) return(trueCell);
2028 return(nilCell);
2029 }
2030 }
2031
2032 else
2033 {
2034 /* return semaphore value, not on Win32 ? */
2035 return(nilCell);
2036 }
2037 }
2038
2039 /* create semaphore */
2040 if((sem_id = winCreateSemaphore()) == 0) return(nilCell);
2041 return(stuffInteger(sem_id));
2042 }
2043 #else /* Mac OS X, Linux/UNIX */
2044
p_semaphore(CELL * params)2045 CELL * p_semaphore(CELL * params)
2046 {
2047 INT sem, value, result;
2048
2049 if(params == nilCell)
2050 {
2051 result = semaphore(0, 0, SEM_CREATE);
2052 goto SEMAPHORE_END;
2053 }
2054
2055 params = getInteger(params, (UINT *)&sem);
2056 if(params == nilCell)
2057 {
2058 result = semaphore(sem, 0, SEM_STATUS);
2059 goto SEMAPHORE_END;
2060 }
2061
2062 getInteger(params, (UINT *)&value);
2063 {
2064 result = semaphore(sem, value, SEM_SIGNAL);
2065 if(result != -1) return(trueCell);
2066 }
2067
2068 SEMAPHORE_END:
2069 if(result == -1) return(nilCell);
2070 return(stuffInteger((UINT)result));
2071 }
2072
2073
semaphore(UINT sem_id,int value,int type)2074 int semaphore(UINT sem_id, int value, int type)
2075 {
2076 struct sembuf sem_b;
2077 #ifdef SPARC
2078 #ifndef NEWLISP64
2079 int semun_val = 0;
2080 #endif
2081 #endif
2082
2083 #if defined(MAC_OSX) || defined(LINUX) || defined(KFREEBSD)
2084 union semun semu;
2085
2086 semu.val = 0;
2087 #endif
2088
2089 if(type != SEM_CREATE)
2090 {
2091 if(type == SEM_SIGNAL)
2092 {
2093 if(value == 0)
2094 {
2095 /* remove semaphore */
2096 #ifdef SPARC
2097 #ifndef NEWLISP64
2098 if(semctl(sem_id, 0, IPC_RMID, &semun_val) == -1) /* SPARC 32 */
2099 #else
2100 if(semctl(sem_id, 0, IPC_RMID, 0) == -1) /* SPARC 64 */
2101 #endif
2102
2103 #else /* not SPARC */
2104 #if defined(MAC_OSX) || defined(LINUX) || defined(KFREEBSD)
2105 if(semctl(sem_id, 0, IPC_RMID, semu) == -1) /* MAC_OSX, GNU/Linux, GNU/kFreeBSD */
2106 #else
2107 if(semctl(sem_id, 0, IPC_RMID, 0) == -1) /* BSD, TRU64 */
2108 #endif /* not MAC_OSX */
2109 #endif /* not SPARC */
2110 return(-1);
2111 return(0);
2112 }
2113
2114 /* wait or signal */
2115 sem_b.sem_num = 0;
2116 sem_b.sem_op = value;
2117 sem_b.sem_flg = 0;
2118 if(semop(sem_id, &sem_b, 1) == -1)
2119 return(-1);
2120 return(0);
2121 }
2122
2123 else
2124 /* return semaphore value */
2125 #if defined(MAC_OSX) || defined(LINUX) || defined(KFREEBSD)
2126 return(semctl(sem_id, 0, GETVAL, semu));
2127 #else
2128 return(semctl(sem_id, 0, GETVAL, 0));
2129 #endif
2130 }
2131
2132 /* create semaphore */
2133 sem_id = semget(IPC_PRIVATE, 1, 0666 );
2134
2135 #ifdef SPARC
2136 #ifndef NEWLISP64
2137 if(semctl(sem_id, 0, SETVAL, &semun_val) == -1) /* SPARC 32 */
2138 #else
2139 if(semctl(sem_id, 0, SETVAL, 0) == -1) /* SPARC 64 */
2140 #endif
2141 #else /* not SPARC */
2142 #if defined(MAC_OSX) || defined(LINUX) || defined(KFREEBSD)
2143 if(semctl(sem_id, 0, SETVAL, semu) == -1) /* MAC_OSX, GNU/Linux, GNU/kFreeBSD */
2144 #else
2145 if(semctl(sem_id, 0, SETVAL, 0) == -1) /* BSD, TRU64 */
2146 #endif /* not MAC_OSX */
2147 #endif /* not SPARC */
2148 return(-1);
2149
2150 return(sem_id);
2151 }
2152
2153 #endif /* MAC OSX, Unix, Linux */
2154 #endif /* NO_SEMAPHORE */
2155
2156
2157 #ifndef NO_SHARE
2158
2159 #ifdef WINDOWS
2160 UINT winSharedMemory(int size);
2161 UINT * winMapView(UINT handle, int size);
2162 #endif
2163
2164 /* since 10.1.0 also can share object > pagesize
2165 objects are stored in the tmp directory of OS
2166 as a file starting with nls-
2167 */
2168
p_share(CELL * params)2169 CELL * p_share(CELL * params)
2170 {
2171 void * address;
2172 CELL * cell;
2173 #ifdef WINDOWS
2174 UINT handle;
2175 #endif
2176
2177 /* read write or release (UNIX) shared memory */
2178 if(params != nilCell)
2179 {
2180 cell = evaluateExpression(params);
2181 #ifndef WINDOWS
2182 if(isNil(cell)) /* release shared address */
2183 {
2184 getInteger(params->next, (UINT *)&address);
2185 checkDeleteShareFile(address);
2186 if(munmap(address, pagesize) == -1)
2187 return(nilCell);
2188 else
2189 return(trueCell);
2190 }
2191 #endif
2192 getIntegerExt(cell, (UINT *)&address, FALSE);
2193 params = params->next;
2194 #ifdef WINDOWS
2195 if((address = winMapView((UINT)address, pagesize)) == NULL)
2196 return(nilCell);
2197 #endif
2198 return(readWriteShared(address, params, 0));
2199 }
2200
2201 /* get shared memory UNIX */
2202 #ifndef WINDOWS
2203 if((address = (UINT*)mmap(
2204 0, pagesize, PROT_READ | PROT_WRITE, MAP_SHARED | MAP_ANON, -1, 0)) == (void*)-1)
2205 return(nilCell);
2206
2207 memset((char *)address, 0, pagesize);
2208 return(stuffInteger((UINT)address));
2209
2210 /* get shared memory WINDOWS */
2211 #else
2212
2213 if((handle = winSharedMemory(pagesize)) == 0)
2214 return(nilCell);
2215
2216 if((address = winMapView(handle, pagesize)) == NULL)
2217 return(nilCell);
2218
2219 memset((char *)address, 0, pagesize);
2220 return(stuffInteger(handle));
2221 #endif
2222 }
2223 #endif /* NO_SHARE */
2224
2225 /* evaluate the expression in params and the write the result
2226 to shared memory. If size > pagesize use files tmp files
2227 for transfer. For atomic datatypes are xlation into message
2228 optimized for speed (but doesn't bring much in overall
2229 performance, should perhaps be taken out and only use
2230 readWriteSharedExpression() */
readWriteShared(UINT * address,CELL * params,int flag)2231 CELL * readWriteShared(UINT * address, CELL * params, int flag)
2232 {
2233 CELL * cell;
2234 size_t size;
2235 char * str;
2236 int errNo;
2237
2238 /* write to shared memory */
2239 if(params != nilCell)
2240 {
2241 if(flag) /* in spawned process */
2242 {
2243 if((cell = evaluateExpressionSafe(params, &errNo)) == NULL)
2244 cell = stuffString(errorStream.buffer);
2245 }
2246 else
2247 cell = evaluateExpression(params);
2248
2249 /* if a previous share mem file is still present, delete it
2250 when *address == 0 when called from Cilk then file is
2251 deleted p_message(). Here only used from p_share() */
2252 if(*address == (CELL_STRING | SHARED_MEM_EVAL_MASK))
2253 checkDeleteShareFile(address);
2254
2255 /* write anything not bool, number or string */
2256 if((cell->type & COMPARE_TYPE_MASK) > (CELL_STRING & COMPARE_TYPE_MASK))
2257 return(copyCell(readWriteSharedExpression(address, cell)));
2258
2259 switch(cell->type)
2260 {
2261 case CELL_NIL:
2262 *address = cell->type;
2263 #ifdef WINDOWS
2264 UnmapViewOfFile(address);
2265 #endif
2266 return(nilCell);
2267 case CELL_TRUE:
2268 *address = cell->type;
2269 #ifdef WINDOWS
2270 UnmapViewOfFile(address);
2271 #endif
2272 return(trueCell);
2273 case CELL_LONG:
2274 *(address + 1) = sizeof(INT);
2275 *(address + 2) = cell->contents;
2276 break;
2277 #ifndef NEWLISP64
2278 case CELL_INT64:
2279 *(address + 1) = sizeof(INT64);
2280 memcpy(address + 2, (void *)&cell->aux, sizeof(INT64));
2281 break;
2282 case CELL_FLOAT:
2283 *(address + 1) = sizeof(double);
2284 *(address + 2) = cell->aux;
2285 *(address + 3) = cell->contents;
2286 break;
2287 #else /* NEWLISP64 */
2288 case CELL_FLOAT:
2289 *(address + 1) = sizeof(double);
2290 *(address + 2) = cell->contents;
2291 break;
2292 #endif /* NEWLISP64 */
2293 case CELL_STRING:
2294 getStringSize(cell, &str, &size, FALSE);
2295 if(size > (pagesize - 3 * sizeof(INT)))
2296 return(copyCell(readWriteSharedExpression(address, cell)));
2297
2298 *(address + 1) = size;
2299 memcpy((char *)(address + 2), str, size);
2300 *((char *)address + 2 * sizeof(INT) + size) = 0;
2301 break;
2302 default:
2303 return(errorProcExt(ERR_ILLEGAL_TYPE, cell));
2304 }
2305
2306 *address = cell->type;
2307 #ifdef WINDOWS
2308 UnmapViewOfFile(address);
2309 #endif
2310 return(copyCell(cell));
2311 }
2312
2313 /* read shared memory */
2314 switch(*address & RAW_TYPE_MASK)
2315 {
2316 case CELL_NIL:
2317 #ifdef WINDOWS
2318 UnmapViewOfFile(address);
2319 #endif
2320 return(nilCell);
2321 case CELL_TRUE:
2322 #ifdef WINDOWS
2323 UnmapViewOfFile(address);
2324 #endif
2325 return(trueCell);
2326 case CELL_LONG:
2327 cell = stuffInteger(*(address + 2));
2328 break;
2329 #ifndef NEWLISP64
2330 case CELL_INT64:
2331 cell = stuffInteger64(*(INT64 *)(address + 2));
2332 break;
2333 #endif
2334 case CELL_FLOAT:
2335 #ifndef NEWLISP64
2336 cell = getCell(CELL_FLOAT);
2337 cell->aux = *(address + 2);
2338 cell->contents = *(address + 3);
2339 #else
2340 cell = getCell(CELL_FLOAT);
2341 cell->contents = *(address + 2);
2342 #endif
2343 break;
2344 case CELL_STRING:
2345 if(*address & SHARED_MEM_EVAL_MASK)
2346 return(readWriteSharedExpression(address, nilCell));
2347 size = *(address + 1);
2348 cell = makeStringCell(allocMemory(size + 1), size);
2349 memcpy((char *)cell->contents, (char*)(address + 2), cell->aux);
2350 break;
2351 default:
2352 return(nilCell);
2353 }
2354
2355 #ifdef WINDOWS
2356 UnmapViewOfFile(address);
2357 #endif
2358 return(cell);
2359 }
2360
2361
2362 /* Takes anything and passes as string or file which has to
2363 be compiled back into expression when reading.
2364 Returns a new cell object on read, old on write
2365 */
2366
readWriteSharedExpression(UINT * address,CELL * params)2367 CELL * readWriteSharedExpression(UINT * address, CELL * params)
2368 {
2369 ssize_t size;
2370 STREAM strStream = {NULL, NULL, 0, 0, 0};
2371 CELL * cell;
2372 char * buffer = NULL;
2373 /* int errNo; */
2374
2375 /* read */
2376 if(params == nilCell)
2377 {
2378 size = *(address + 1);
2379 if(size < (pagesize - 3 * sizeof(INT) ))
2380 {
2381 cell = sysEvalString((char *)(address + 2),
2382 currentContext, nilCell, READ_EXPR_SYNC);
2383 }
2384 else
2385 {
2386 if((size = readFile((char *)(address + 2), &buffer)) != -1)
2387 cell = sysEvalString(buffer, currentContext, nilCell, READ_EXPR_SYNC);
2388 else cell = nilCell;
2389 }
2390
2391 if(buffer != NULL) free(buffer);
2392 return(cell);
2393 }
2394
2395 /* write */
2396 cell = params;
2397 openStrStream(&strStream, MAX_STRING, 0);
2398 prettyPrintFlags |= PRETTYPRINT_STRING;
2399 printCell(cell , TRUE, (UINT)&strStream);
2400 prettyPrintFlags &= ~PRETTYPRINT_STRING;
2401
2402 *(address + 1) = strStream.position;
2403
2404 if(strStream.position < pagesize - 3 * sizeof(INT))
2405 {
2406 memcpy((char *)(address + 2), strStream.buffer, strStream.position);
2407 *((char *)address + 2 * sizeof(INT) + strStream.position) = 0;
2408 }
2409 else
2410 {
2411 checkDeleteShareFile(address);
2412 memset((char *)(address + 2), 0, pagesize - 2 * sizeof(INT));
2413 strncpy((char *)(address + 2), tempDir, PATH_MAX - 2 * sizeof(INT));
2414 strncat((char *)(address + 2), "/nls-", 6);
2415 size = strlen((char *)(address + 2));
2416 getUUID((char *)(address + 2) + size, 0);
2417 writeFile((char *)(address + 2), strStream.buffer, strStream.position, "w");
2418 }
2419 closeStrStream(&strStream);
2420
2421 *address = (CELL_STRING | SHARED_MEM_EVAL_MASK);
2422 return(cell);
2423 }
2424
checkDeleteShareFile(UINT * address)2425 void checkDeleteShareFile(UINT * address)
2426 {
2427 if( (*address == (CELL_STRING | SHARED_MEM_EVAL_MASK)) &&
2428 #ifndef WINDOWS
2429 #ifdef ANDROID
2430 (strncmp((char *)(address + 2), "/data/tmp/nls-", 9) == 0) &&
2431 #else
2432 (strncmp((char *)(address + 2), "/tmp/nls-", 9) == 0) &&
2433 #endif
2434 (strlen((char *)(address + 2)) == 45) )
2435 #else
2436 (strncmp((char *)(address + 2), "/temp/nls-", 10) == 0) &&
2437 (strlen((char *)(address + 2)) == 46) )
2438 #endif
2439 unlink((char *)(address + 2));
2440 }
2441 #endif /* ifndef EMSCRIPTEN */
2442
2443 extern int ADDR_FAMILY;
p_systemInfo(CELL * params)2444 CELL * p_systemInfo(CELL * params)
2445 {
2446 CELL * cell;
2447
2448 cell = stuffIntegerList(
2449 10,
2450 cellCount,
2451 MAX_CELL_COUNT,
2452 symbolCount,
2453 (UINT)recursionCount,
2454 (UINT)(envStackIdx - envStack)/sizeof(UINT),
2455 (UINT)MAX_CPU_STACK,
2456 (UINT)parentPid,
2457 (UINT)getpid(),
2458 (UINT)version,
2459 (UINT)opsys
2460 );
2461
2462 if(params != nilCell)
2463 {
2464 pushResult(cell);
2465 return(copyCell(implicitIndexList(cell, params)));
2466 }
2467
2468 return(cell);
2469 }
2470
2471
p_systemError(CELL * params)2472 CELL * p_systemError(CELL * params)
2473 {
2474 CELL * cell;
2475 UINT errnum = errno;
2476
2477 if(params != nilCell)
2478 {
2479 getInteger(params, &errnum);
2480 if(errnum == 0) errno = 0;
2481 }
2482 else
2483 if(!errnum) return(nilCell);
2484
2485 cell = makeCell(CELL_EXPRESSION, (UINT)stuffInteger(errnum));
2486 ((CELL *)cell->contents)->next = stuffString(strerror(errnum));
2487
2488 /* on some platforms strerror(0) causes errno set to 22 */
2489 if(errnum == 0) errno = 0;
2490
2491 return(cell);
2492 }
2493
2494 /* ------------------------------ time and date functions -------------------- */
p_date(CELL * params)2495 CELL * p_date(CELL * params)
2496 {
2497 time_t t;
2498 struct tm * ltm;
2499 char * ct;
2500 char * fmt;
2501 ssize_t offset;
2502 /* time_t tme; 10.6.1. */
2503 UINT tme;
2504 size_t size;
2505
2506 #ifdef SUPPORT_UTF8
2507 #ifdef WCSFTIME
2508 int * ufmt;
2509 int * timeString;
2510 #endif
2511 char * utf8str;
2512 #else
2513 char * timeString;
2514 #endif
2515
2516 if(params == nilCell)
2517 t = (time_t)currentDateValue();
2518 else
2519 {
2520 /* 10.6.1 */
2521 params = getInteger(params, &tme);
2522 t = (time_t)tme;
2523
2524 if(params != nilCell)
2525 {
2526 params = getInteger(params, (UINT *)&offset);
2527 t += (int)offset * 60;
2528 }
2529
2530 if(params != nilCell)
2531 {
2532 params = getStringSize(params, &fmt, &size, TRUE);
2533 ltm = localtime(&t);
2534 #ifdef SUPPORT_UTF8
2535 /* some Linux do UTF-8 but don't have wcsftime() or it is buggy */
2536 #ifdef WCSFTIME
2537 size = utf8_wlen(fmt, fmt + size + 1);
2538 ufmt = alloca(UTF8_MAX_BYTES * (size + 1));
2539 utf8_wstr(ufmt, fmt, size);
2540
2541 timeString = alloca(UTF8_MAX_BYTES * 128);
2542 size = wcsftime((wchar_t *)timeString, 127, (wchar_t *)ufmt, ltm);
2543 utf8str = alloca(size * UTF8_MAX_BYTES + 1);
2544 size = wstr_utf8(utf8str, timeString, size * UTF8_MAX_BYTES);
2545 return(stuffString(utf8str));
2546 #else
2547 utf8str = alloca(128);
2548 strftime(utf8str, 127, fmt, ltm);
2549 return(stuffString(utf8str));
2550 #endif /* WCSFTIME */
2551
2552 #else
2553 timeString = alloca(128);
2554 strftime(timeString, 127, fmt, ltm);
2555 return(stuffString(timeString));
2556 #endif
2557 }
2558 }
2559
2560 ct = ctime(&t);
2561 if(ct == NULL) return(nilCell);
2562
2563 ct[strlen(ct) - 1] = 0; /* supress linefeed */
2564 return(stuffString(ct));
2565 }
2566
microSecTime(void)2567 INT64 microSecTime(void)
2568 {
2569 struct timeval tv;
2570 struct tm * ttm;
2571 time_t sec;
2572
2573 gettimeofday(&tv, NULL);
2574 sec = tv.tv_sec;
2575 ttm = localtime(&sec);
2576
2577 return (ttm->tm_hour * 3600000000LL +
2578 ttm->tm_min * 60000000LL + ttm->tm_sec * 1000000 +
2579 tv.tv_usec);
2580 }
2581
2582
milliSecTime(void)2583 int milliSecTime(void)
2584 {
2585 return(microSecTime()/1000);
2586 }
2587
2588
2589 /* returns a differerence of 2 timeval structs in milliseconds
2590 */
timediff_ms(struct timeval out,struct timeval in)2591 int timediff_ms(struct timeval out, struct timeval in )
2592 {
2593 if( (out.tv_usec -= in.tv_usec) < 0 ) {
2594 out.tv_sec--;
2595 out.tv_usec += 1000000;
2596 }
2597 out.tv_sec -= in.tv_sec;
2598
2599 return(out.tv_sec*1000 + (out.tv_usec/1000));
2600 }
2601
2602
2603 /* returns a differerence of 2 timeval structs in microseconds
2604 */
timediff64_us(struct timeval out,struct timeval in)2605 UINT64 timediff64_us(struct timeval out, struct timeval in )
2606 {
2607 UINT64 usec;
2608
2609 if( (out.tv_usec -= in.tv_usec) < 0 ) {
2610 out.tv_sec--;
2611 out.tv_usec += 1000000;
2612 }
2613 out.tv_sec -= in.tv_sec;
2614
2615 usec = (UINT64)1000000 * out.tv_sec + out.tv_usec;
2616 return(usec);
2617 }
2618
2619 #ifndef WINDOWS
p_dateParse(CELL * params)2620 CELL * p_dateParse(CELL * params)
2621 {
2622 struct tm ttm;
2623 char * dateStr;
2624 char * formatStr;
2625 time_t dateValue;
2626
2627 params = getString(params, &dateStr);
2628 getString(params, &formatStr);
2629
2630 memset (&ttm, 0, sizeof (ttm));
2631 ttm.tm_mday = 1;
2632
2633 if(strptime(dateStr, formatStr, &ttm) == NULL)
2634 return(nilCell);
2635
2636 dateValue = calcDateValue(
2637 ttm.tm_year + 1900,
2638 ttm.tm_mon + 1,
2639 ttm.tm_mday,
2640 ttm.tm_hour,
2641 ttm.tm_min,
2642 ttm.tm_sec);
2643
2644 return(stuffInteger(dateValue));
2645 }
2646 #endif
2647
p_time(CELL * params)2648 CELL * p_time(CELL * params)
2649 {
2650 struct timeval start, end;
2651 INT64 N = 1;
2652 UINT * resultIdxSave;
2653 double diff;
2654
2655 gettimeofday(&start, NULL);
2656 if(params->next != nilCell)
2657 getInteger64Ext(params->next, &N, TRUE);
2658
2659 resultIdxSave = resultStackIdx;
2660 while(N--)
2661 {
2662 evaluateExpression(params);
2663 cleanupResults(resultIdxSave);
2664 }
2665
2666 gettimeofday(&end, NULL);
2667
2668 diff = (1.0 * timediff64_us(end, start)) / 1000;
2669 return(stuffFloat(diff));
2670 }
2671
2672
p_timeOfDay(CELL * params)2673 CELL * p_timeOfDay(CELL * params)
2674 {
2675 double microSecs = microSecTime()/1000.0;
2676 return(stuffFloat(microSecs));
2677 }
2678
2679
p_now(CELL * params)2680 CELL * p_now(CELL * params)
2681 {
2682 struct timeval tv;
2683 struct tm *ttm;
2684 #ifndef WINDOWS
2685 struct tm *ltm;
2686 #ifndef SUNOS
2687 #ifndef OS2
2688 #ifndef AIX
2689 INT gmtoff;
2690 UINT isdst;
2691 #endif
2692 #endif
2693 #endif
2694 #else /* WINDOWS */
2695 TIME_ZONE_INFORMATION timeZone;
2696 int retval;
2697 #endif
2698 ssize_t offset = 0;
2699 time_t sec;
2700 CELL * cell;
2701
2702 gettimeofday(&tv, NULL);
2703
2704 if(params != nilCell)
2705 {
2706 params = getInteger(params, (UINT*)&offset);
2707 offset *= 60;
2708 tv.tv_sec += offset;
2709 }
2710
2711 #ifndef WINDOWS
2712 ltm = localtime((time_t *)&tv.tv_sec);
2713 #ifndef SUNOS
2714 #ifndef OS2
2715 #ifndef AIX
2716 isdst = ltm->tm_isdst;
2717
2718 #ifdef CYGWIN
2719 gmtoff = _timezone/60;
2720 #else
2721 gmtoff = ltm->tm_gmtoff/60;
2722 #endif
2723
2724 #endif
2725 #endif
2726 #endif
2727 #else /* WINDOWS */
2728 memset((void *)&timeZone, 0, sizeof(timeZone));
2729 retval = GetTimeZoneInformation(&timeZone);
2730 #endif
2731
2732 sec = tv.tv_sec;
2733 ttm = gmtime(&sec);
2734
2735 cell = stuffIntegerList(
2736 11,
2737 (UINT)ttm->tm_year + 1900,
2738 (UINT)ttm->tm_mon + 1,
2739 (UINT)ttm->tm_mday,
2740 (UINT)ttm->tm_hour,
2741 (UINT)ttm->tm_min,
2742 (UINT)ttm->tm_sec,
2743 (UINT)tv.tv_usec,
2744 (UINT)ttm->tm_yday + 1,
2745 ((UINT)ttm->tm_wday == 0 ? 7 : (UINT)ttm->tm_wday),
2746
2747 #if defined(MAC_OSX) || defined(LINUX) || defined(_BSD) || defined(KFREEBSD) || defined(CYGWIN)
2748 gmtoff, isdst
2749 #endif
2750
2751 #if defined(SUNOS)
2752 timezone/60, daylight
2753 #endif
2754
2755 #if defined(OS2) || defined(TRU64) || defined(AIX)
2756 #ifdef NEWLISP64
2757 (UINT)0L, (UINT)0L
2758 #else
2759 (UINT)0, (UINT)0
2760 #endif
2761 #endif
2762
2763 #if defined(WINDOWS)
2764 (retval == 2) ? ((UINT)-timeZone.Bias - (UINT)timeZone.DaylightBias) : (UINT)-timeZone.Bias,
2765 (UINT)retval
2766 #endif
2767 );
2768
2769 if(params != nilCell)
2770 {
2771 pushResult(cell);
2772 return(copyCell(implicitIndexList(cell, params)));
2773 }
2774
2775 return(cell);
2776 }
2777
p_dateList(CELL * params)2778 CELL * p_dateList(CELL * params)
2779 {
2780 struct tm *ttm;
2781 ssize_t timeValue;
2782 time_t timer;
2783 CELL * cell;
2784
2785 if(params == nilCell)
2786 timeValue = currentDateValue();
2787 else
2788 params = getInteger(params, (UINT*)&timeValue);
2789
2790 timer = (time_t)timeValue;
2791 if((ttm = gmtime(&timer)) == NULL)
2792 return(errorProcExt2(ERR_INVALID_PARAMETER, stuffInteger((UINT)timeValue)));
2793
2794 cell = stuffIntegerList(
2795 8,
2796 (UINT)ttm->tm_year + 1900,
2797 (UINT)ttm->tm_mon + 1,
2798 (UINT)ttm->tm_mday,
2799 (UINT)ttm->tm_hour,
2800 (UINT)ttm->tm_min,
2801 (UINT)ttm->tm_sec,
2802 (UINT)ttm->tm_yday + 1,
2803 ((UINT)ttm->tm_wday == 0 ? 7 : (UINT)ttm->tm_wday)
2804 );
2805
2806 if(params != nilCell)
2807 {
2808 pushResult(cell);
2809 return(copyCell(implicitIndexList(cell, params)));
2810 }
2811
2812 return(cell);
2813 }
2814
currentDateValue(void)2815 ssize_t currentDateValue(void)
2816 {
2817 struct timeval tv;
2818
2819 gettimeofday(&tv, NULL);
2820 return(tv.tv_sec);
2821 }
2822
p_dateValue(CELL * params)2823 CELL * p_dateValue(CELL * params)
2824 {
2825 ssize_t year, month, day, hour, min, sec;
2826 time_t dateValue;
2827 int evalFlag = TRUE;
2828 CELL * next;
2829
2830 if(params->type == CELL_NIL)
2831 return(stuffInteger(currentDateValue()));
2832
2833 next = params->next;
2834 params = evaluateExpression(params);
2835 if(params->type == CELL_EXPRESSION)
2836 {
2837 params = (CELL *)params->contents;
2838 next = params->next;
2839 evalFlag = FALSE;
2840 }
2841
2842 params = getIntegerExt(params, (UINT *)&year, FALSE);
2843 params = getIntegerExt(next, (UINT *)&month, evalFlag);
2844 params = getIntegerExt(params, (UINT *)&day, evalFlag);
2845
2846 hour = min = sec = 0;
2847 if(params != nilCell)
2848 {
2849 params = getIntegerExt(params, (UINT *)&hour, evalFlag);
2850 params = getIntegerExt(params, (UINT *)&min, evalFlag);
2851 getIntegerExt(params, (UINT *)&sec, evalFlag);
2852 }
2853
2854 dateValue = calcDateValue(year, month, day, hour, min, sec);
2855
2856 #ifndef NEWLISP64
2857 return(stuffInteger64((INT64)dateValue));
2858 #else
2859 return(stuffInteger((UINT)dateValue));
2860 #endif
2861 }
2862
2863
2864
2865 /* changed for 10.6.1 where time_t can be 64-bit on 32-bit Windows */
calcDateValue(int year,int month,int day,int hour,int min,int sec)2866 time_t calcDateValue(int year, int month, int day, int hour, int min, int sec)
2867 {
2868 time_t dateValue;
2869 INT64 value;
2870
2871 value = 367 * year - (7 * (year + ((month + 9) / 12)))/4
2872 + (275 * month)/9 + day + 1721013;
2873
2874 value = value * 24 * 3600 + hour * 3600 + min * 60 + sec
2875 - 413319296; /* correction for 1970-1-1 */
2876
2877 if(sizeof(time_t) == 8)
2878 {
2879 if(value & 0x80000000)
2880 dateValue = value | 0xFFFFFFFF00000000LL;
2881 else
2882 dateValue = value & 0x00000000FFFFFFFF;
2883 }
2884 else
2885 dateValue = value;
2886
2887 return(dateValue);
2888 }
2889
2890
2891 #ifdef MAC_OSX
2892 extern int nanosleep();
2893 #endif
2894
mySleep(int ms)2895 void mySleep(int ms)
2896 {
2897 #ifdef NANOSLEEP
2898 struct timespec tm;
2899
2900 tm.tv_sec = ms / 1000;
2901 tm.tv_nsec = (ms - tm.tv_sec * 1000) * 1000000;
2902 nanosleep(&tm, 0);
2903
2904 #else
2905
2906 #ifdef WINDOWS
2907 Sleep(ms);
2908 #else
2909 sleep((ms + 500)/1000);
2910 #endif
2911
2912 #endif
2913 }
2914
2915 #ifdef NANOSLEEP
myNanoSleep(int nanosec)2916 void myNanoSleep(int nanosec)
2917 {
2918 struct timespec tm;
2919
2920 tm.tv_sec = nanosec / 1000000000;
2921 tm.tv_nsec = (nanosec - tm.tv_sec * 1000000000);
2922 nanosleep(&tm, 0);
2923 }
2924 #endif
2925
2926
p_sleep(CELL * params)2927 CELL * p_sleep(CELL * params)
2928 {
2929 double milliSecsFloat;
2930 #ifdef NANOSLEEP
2931 int nanoSecsInt;
2932 #endif
2933
2934 getFloat(params, &milliSecsFloat);
2935
2936 mySleep((UINT)milliSecsFloat);
2937 #ifdef NANOSLEEP
2938 nanoSecsInt = (milliSecsFloat - (int)milliSecsFloat) * 1000000;
2939 if(nanoSecsInt) myNanoSleep(nanoSecsInt);
2940 #endif
2941
2942 return(stuffFloat(milliSecsFloat));
2943 }
2944
2945 /* -------------------------------- environment functions ------------------- */
2946
2947
p_env(CELL * params)2948 CELL * p_env(CELL * params)
2949 {
2950 char * varName;
2951 char * varValue;
2952
2953 /* no parameters returns whole environment */
2954 if(params == nilCell)
2955 return(environment());
2956
2957 /* one parameter get environment for one variable */
2958 params = getString(params, &varName);
2959 if(params == nilCell)
2960 {
2961 if( (varValue = getenv(varName)) == NULL)
2962 return(nilCell);
2963 return(stuffString(varValue));
2964 }
2965
2966 /* two parameters sets environment for one variable */
2967 getString(params, &varValue);
2968 #ifndef MY_SETENV
2969 if(*varValue == 0)
2970 unsetenv(varName);
2971 else
2972 #endif
2973 if(setenv(varName, varValue, 1) != 0)
2974 return(nilCell);
2975
2976 return(trueCell);
2977 }
2978
2979
2980 #ifdef MY_SETENV
my_setenv(const char * varName,const char * varValue,int flag)2981 int my_setenv(const char * varName, const char * varValue, int flag)
2982 {
2983 char * envstr;
2984 envstr = alloca(strlen(varName) + strlen(varValue) + 2);
2985 strcpy(envstr, varName);
2986 strcat(envstr, "=");
2987 strcat(envstr, varValue);
2988 return(putenv(envstr));
2989 }
2990 #endif
2991
2992
environment(void)2993 CELL * environment(void)
2994 {
2995 char ** env;
2996 CELL * envList;
2997 CELL * lastEntry;
2998 CELL * pair;
2999 char * ptr;
3000
3001 lastEntry = NULL;
3002 envList = getCell(CELL_EXPRESSION);
3003
3004 env = environ;
3005
3006 while(*env)
3007 {
3008 if((ptr = strstr(*env, "=")) != NULL)
3009 {
3010 pair = getCell(CELL_EXPRESSION);
3011 addList(pair, stuffStringN(*env, ptr - *env));
3012 addList(pair, stuffString(ptr + 1));
3013 }
3014 else
3015 {
3016 env++;
3017 continue;
3018 }
3019
3020 if(lastEntry == NULL)
3021 {
3022 lastEntry = pair;
3023 envList->contents = (UINT)lastEntry;
3024 }
3025 else
3026 {
3027 lastEntry->next = pair;
3028 lastEntry = lastEntry->next;
3029 }
3030 env++;
3031 }
3032
3033 return(envList);
3034 }
3035
3036 /* --------------------- read the keyboard -----------------------------------*/
3037
3038 /* thanks to Peter van Eerten for contributing this function */
3039 /* included non-blocking ability 10.7.3, LM */
3040
p_readKey(CELL * params)3041 CELL * p_readKey(CELL * params)
3042 {
3043
3044 #if defined(WINDOWS) || defined(OS2)
3045 if(!isNil(evaluateExpression(params)) )
3046 {
3047 if(kbhit())
3048 return(stuffInteger(getch()));
3049 else
3050 return(stuffInteger(0));
3051 }
3052 else
3053 return(stuffInteger(getch()));
3054 #else
3055
3056 struct termios term, oterm;
3057 char ch = 0;
3058 int noblock = 0;
3059 int oldf;
3060
3061 noblock = !isNil(evaluateExpression(params));
3062
3063 tcgetattr(0, &oterm);
3064 term = oterm;
3065 term.c_lflag &= ~(ICANON | ECHO);
3066
3067 if(!noblock)
3068 {
3069 term.c_cc[VMIN] = 0;
3070 term.c_cc[VTIME] = 1;
3071 }
3072
3073 tcsetattr(STDIN_FILENO, TCSANOW, &term);
3074
3075 if(noblock)
3076 {
3077 oldf = fcntl(STDIN_FILENO, F_GETFL, 0);
3078 fcntl(STDIN_FILENO, F_SETFL, oldf | O_NONBLOCK);
3079 }
3080
3081 while(read(STDIN_FILENO, &ch, 1) == 0);
3082
3083 if(noblock)
3084 fcntl(STDIN_FILENO, F_SETFL, oldf);
3085
3086 tcsetattr(STDIN_FILENO, TCSANOW, &oterm);
3087
3088 if(ch != EOF)
3089 return(stuffInteger((UINT)ch));
3090
3091 return(stuffInteger(0));
3092 #endif /* not Windows or OS2 */
3093 }
3094
3095 /* --------------------- peek a file descriptor ------------------------------*/
3096
3097 #ifndef WINDOWS
p_peek(CELL * params)3098 CELL * p_peek(CELL * params)
3099 {
3100 UINT handle;
3101 int result;
3102
3103 getInteger(params, &handle);
3104
3105 if(ioctl((int)handle, FIONREAD, &result) < 0)
3106 return(nilCell);
3107
3108 return(stuffInteger((UINT)result));
3109 }
3110 #endif
3111
3112 /* --------------------- library functions not found on some OSs -------------*/
3113
3114 #ifdef MY_VASPRINTF
my_vasprintf(char ** buffer,const char * format,va_list argptr)3115 int my_vasprintf(char * * buffer, const char * format, va_list argptr)
3116 {
3117 int size;
3118
3119 /* get size */
3120 size = vsnprintf(NULL, 0, format, argptr);
3121 if (size < 0) return -1;
3122
3123 *buffer = calloc(size + 1, 1);
3124 if (!*buffer) return(-1);
3125
3126 vsnprintf(*buffer, size + 1, format, argptr);
3127 (*buffer)[size] = '\0';
3128
3129 return(size);
3130 }
3131 #endif
3132
3133
3134 /* ---------------------- Universal Unique ID version 1 and 3 ----------- */
3135
3136 #define UINT16 unsigned short
3137 #define UINT32 unsigned int
3138
3139 typedef struct
3140 {
3141 UINT32 time_low;
3142 UINT16 time_mid;
3143 UINT16 time_hi_and_version;
3144 unsigned char clock_seq_hi_and_reserved;
3145 unsigned char clock_seq_low;
3146 unsigned char node[6];
3147 } UUID;
3148
3149 UINT16 clock_seq = 0;
3150 INT64 last_time = 0;
3151 char last_node[6];
3152
3153 #define OCT151582 0x01B21DD213814000LL
3154
getUUID(char * str,char * node)3155 char * getUUID(char * str, char * node)
3156 {
3157 UUID uuid;
3158 struct timeval tp;
3159 INT64 timestamp;
3160 UINT16 nodeID[3];
3161 int uuid_version;
3162
3163 gettimeofday(&tp, (struct timezone *)0);
3164
3165 /* add UUID UTC offset Oct 15, 1582 */
3166 timestamp = tp.tv_sec * (INT64)10000000 + tp.tv_usec * 10 + OCT151582;
3167
3168 #ifdef WINDOWS
3169 if(timestamp <= last_time) timestamp = last_time + 1;
3170 #else
3171 if(timestamp < last_time) clock_seq++;
3172 if(timestamp == last_time) timestamp++;
3173 #endif
3174
3175 if(last_time == 0)
3176 srandom((timestamp & 0xFFFFFFFF) + getpid());
3177
3178 last_time = timestamp;
3179
3180
3181 if(clock_seq == 0) clock_seq = random();
3182 if(node != NULL && (memcmp(last_node, node, 6) != 0))
3183 {
3184 clock_seq = random();
3185 memcpy(last_node, node, 6);
3186 }
3187
3188 if(node == NULL)
3189 {
3190 nodeID[0] = random();
3191 nodeID[1] = random();
3192 nodeID[2] = random();
3193 uuid_version = 4;
3194 memcpy(uuid.node, (void *)nodeID, 6);
3195 }
3196 else
3197 {
3198 uuid_version = 1;
3199 /* least sign bit of first byte must be 0 on MACs
3200 and 1 on artifical generated node IDs */
3201 memcpy(uuid.node, node, 6);
3202 }
3203
3204 if(uuid_version == 4)
3205 {
3206 clock_seq = random();
3207 uuid.time_low = random();
3208 #ifdef WINDOWS
3209 uuid.time_low |= (random() << 16);
3210 #endif
3211 uuid.time_mid = random();
3212 uuid.time_hi_and_version = random();
3213 }
3214 else
3215 {
3216 uuid.time_low = (unsigned int)(timestamp & 0xFFFFFFFF);
3217 uuid.time_mid = (unsigned short)((timestamp >> 32) & 0xFFFF);
3218 uuid.time_hi_and_version = (unsigned short)(timestamp >> 48) ;
3219 }
3220
3221 uuid.time_hi_and_version &= 0x0FFF;
3222 uuid.time_hi_and_version |= (uuid_version << 12);
3223 uuid.clock_seq_low = clock_seq & 0xFF;
3224 uuid.clock_seq_hi_and_reserved = (clock_seq & 0x3F00) >> 8;
3225 uuid.clock_seq_hi_and_reserved |= 0x80;
3226
3227 snprintf(str, 37, "%08X-%04X-%04X-%02X%02X-%02X%02X%02X%02X%02X%02X",
3228 uuid.time_low, uuid.time_mid, uuid.time_hi_and_version,
3229 uuid.clock_seq_hi_and_reserved, uuid.clock_seq_low,
3230 uuid.node[0], uuid.node[1], uuid.node[2],
3231 uuid.node[3], uuid.node[4], uuid.node[5]);
3232
3233 return(str);
3234 }
3235
p_uuid(CELL * params)3236 CELL * p_uuid(CELL * params)
3237 {
3238 char * nodeMAC = NULL;
3239 size_t size;
3240 char str[38];
3241
3242 if(params != nilCell)
3243 {
3244 getStringSize(params, &nodeMAC, &size, TRUE);
3245 if(size < 6) nodeMAC = NULL;
3246 }
3247
3248 return(stuffString(getUUID(str, nodeMAC)));
3249 }
3250
3251
getSymbolCheckProtected(CELL * params)3252 SYMBOL * getSymbolCheckProtected(CELL * params)
3253 {
3254 SYMBOL * sPtr = NULL;
3255 CELL * cell;
3256
3257 if(params->type == CELL_SYMBOL)
3258 {
3259 sPtr = (SYMBOL *)params->contents;
3260 cell = (CELL *)sPtr->contents;
3261 if(cell->type == CELL_CONTEXT)
3262 sPtr = translateCreateSymbol( ((SYMBOL*)cell->contents)->name, CELL_NIL,
3263 (SYMBOL*)cell->contents, TRUE);
3264 }
3265 else if(params->type == CELL_DYN_SYMBOL)
3266 sPtr = getDynamicSymbol(params);
3267 else errorProcExt(ERR_SYMBOL_EXPECTED, params);
3268
3269 if(isProtected(sPtr->flags))
3270 errorProcExt2(ERR_SYMBOL_PROTECTED, stuffSymbol(sPtr));
3271
3272 symbolCheck = sPtr;
3273
3274 return sPtr;
3275 }
3276
3277
3278 /* eof */
3279
3280
3281
3282