nl-filesys.c

   1 /* nl-filesys.c --- I/O process control, date/time - functions for newLISP
   2
   3
   4     Copyright (C) 2008 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 #ifdef SOLARIS
  26 #include <stropts.h>
  27 #ifndef TRU64
  28 #define FIONREAD I_NREAD
  29 #endif
  30 #endif
  31
  32 #ifndef WIN_32
  33 #include <sys/types.h>
  34 #include <sys/ipc.h>
  35 #include <sys/sem.h>
  36 #include <sys/mman.h>
  37 #include <sys/ioctl.h>
  38 #endif
  39
  40 int init_argv(char * ptr, char *argv[]);
  41
  42 #ifdef OS2
  43 #include <conio.h>
  44 int semctl(int semid, int semnum, int cmd, ...);
  45 #endif
  46
  47 #ifdef MAC_OSX
  48 #ifdef LIBRARY
  49 char ** environ = NULL;
  50 #else
  51 extern char ** environ;
  52 #endif
  53 #else
  54 #ifndef TRU64
  55 extern char ** environ;
  56 #endif
  57 #endif
  58
  59
  60 #ifdef WIN_32
  61 #define fgetc win32_fgetc
  62 #define random rand
  63 #define srandom srand
  64 #include <process.h>
  65 #include <conio.h>
  66 #include <dir.h>
  67 #define popen  _popen
  68 #define pclose _pclose
  69 #define pipe _pipe
  70
  71 /*
  72 Set binary as default file mode for Windows.
  73 See also http://www.mingw.org/MinGWiki/index.php/binary
  74 */
  75 unsigned int _CRT_fmode = _O_BINARY;
  76
  77 /* not needed with MinGW gcc 3.4.5
  78 struct timezone
  79         {
  80         int tz_minuteswest;
  81         int tz_dsttime;
  82         };
  83 */
  84
  85 /* with MinGW gcc 3.4.5 not needed
  86 int gettimeofday( struct timeval *tp, struct timezone *tzp );
  87 */
  88
  89 int setenv (const char *name, const char *value, int replace);
  90 #ifdef USE_WIN_UTF16PATH
  91 INT64 fileSizeW(WCHAR * pathName);
  92 #endif
  93
  94 #endif
  95
  96 #ifndef WIN_32
  97 #include <sys/socket.h>
  98 #define SOCKET_ERROR -1
  99 #define INVALID_SOCKET -1
 100 #endif
 101
 102 #ifdef LINUX
 103 char * strptime(const char * str, const char * fmt, struct tm * ttm);
 104 #endif
 105
 106 size_t calcDateValue(int year, int month, int day, int hour, int min, int sec);
 107
 108 extern STREAM readLineStream;
 109 extern FILE * IOchannel;
 110
 111 CELL * p_isFile(CELL * params) /* includes dev,socket,dir,file etc. */
 112 {
 113 char * fileName;
 114
 115 getString(params, &fileName);
 116 if(isFile(fileName) == 0)
 117         return(trueCell);
 118
 119 return(nilCell);
 120 }
 121
 122 int isFile(char * fileName)
 123 {
 124 struct stat fileInfo;
 125
 126
 127 #ifdef USE_WIN_UTF16PATH
 128 return(stat_utf16(fileName, &fileInfo));
 129 #else
 130 return(stat(fileName, &fileInfo));
 131 #endif
 132 }
 133
 134 CELL * p_isDirectory(CELL * params)
 135 {
 136 char * fileName;
 137
 138 getString(params, &fileName);
 139 if(isDir(fileName)) return(trueCell);
 140 return(nilCell);
 141 }
 142
 143
 144 int isDir(char * fileName)
 145 {
 146 struct stat fileInfo;
 147
 148 #ifdef WIN32
 149 char slash;
 150 size_t len;
 151
 152 len = strlen(fileName);
 153 slash = *(fileName + len - 1);
 154 if(slash == '\\' || slash == '/')
 155         *(fileName + len - 1) = 0;
 156 #endif
 157
 158
 159
 160 #ifdef USE_WIN_UTF16PATH
 161 if(stat_utf16(fileName, &fileInfo) != 0)
 162 #else
 163 if(stat(fileName, &fileInfo) != 0)
 164 #endif
 165         {
 166 #ifdef WIN32
 167         *(fileName + len - 1) = slash;
 168 #endif
 169         return(0);
 170         }
 171
 172 #ifdef WIN32
 173 *(fileName + len - 1) = slash;
 174 #endif
 175
 176 if(S_ISDIR(fileInfo.st_mode))
 177         return(1);
 178 return(0);
 179 }
 180
 181
 182
 183 CELL * p_open(CELL * params)
 184 {
 185 char * fileName;
 186 char * accessMode;
 187 char * option = NULL;
 188 int handle;
 189
 190 params = getString(params, &fileName);
 191 params = getString(params, &accessMode);
 192
 193 if(params != nilCell)
 194         getString(params, &option);
 195
 196 if( (handle = openFile(fileName, accessMode, option)) == (int)-1)
 197         return(nilCell);
 198 return(stuffInteger((UINT)handle));
 199 }
 200
 201 CELL * p_close(CELL * params)
 202 {
 203 UINT handle;
 204
 205 getInteger(params, &handle);
 206 if(handle == 0) return(nilCell);
 207 if(handle == printDevice) printDevice = 0;
 208 if(close((int)handle) == -1) return(nilCell);
 209 return(trueCell);
 210 }
 211
 212 CELL * p_readChar(CELL * params)
 213 {
 214 UINT handle;
 215 unsigned char chr;
 216
 217 getInteger(params, &handle);
 218 if(read((int)handle, &chr, 1) <= 0) return(nilCell);
 219
 220 return(stuffInteger((UINT)chr));
 221 }
 222
 223
 224 CELL * p_readBuffer(CELL * params)
 225 {
 226 UINT handle;
 227 size_t size, length;
 228 ssize_t bytesRead = 0;
 229 int found = 0;
 230 char * waitFor;
 231 char chr;
 232 STREAM stream;
 233 CELL * strCell;
 234 SYMBOL * readSptr;
 235
 236 params = getInteger(params, &handle);
 237 params = getSymbol(params, &readSptr);
 238 params = getInteger(params, (UINT *)&size);
 239
 240 if(isProtected(readSptr->flags))
 241         return(errorProcExt2(ERR_SYMBOL_PROTECTED, stuffSymbol(readSptr)));
 242
 243 memset(&stream, 0, sizeof(stream));
 244
 245 if(params == nilCell)
 246         {
 247         openStrStream(&stream, size, 0);
 248         found = 1;
 249         if((bytesRead = read(handle, stream.buffer, size)) == -1)
 250                 {
 251                 closeStrStream(&stream);
 252                 return(nilCell);
 253                 }
 254         }
 255 else
 256         {
 257         getString(params, &waitFor);
 258         openStrStream(&stream, MAX_LINE, 0);
 259         length = strlen(waitFor);
 260         while(bytesRead < size)
 261                 {
 262                 if(read(handle, &chr, 1) <= 0)
 263                         break;
 264
 265                 writeStreamChar(&stream, chr);
 266                 if(++bytesRead < length) continue;
 267                 if(strcmp(waitFor,  stream.ptr - length) == 0)
 268                         {
 269                         found = 1;
 270                         break;
 271                         }
 272                 }
 273         }
 274
 275 if(bytesRead == 0)
 276         {
 277         deleteList((CELL *)readSptr->contents);
 278         readSptr->contents = (UINT)nilCell;
 279         closeStrStream(&stream);
 280         return(nilCell);
 281         }
 282
 283 strCell = getCell(CELL_STRING);
 284 strCell->aux = bytesRead + 1;
 285 stream.buffer = reallocMemory(stream.buffer, bytesRead +1);
 286 strCell->contents = (UINT)stream.buffer;
 287
 288 deleteList((CELL *)readSptr->contents);
 289 readSptr->contents = (UINT)strCell;
 290
 291 if(found)
 292         return(stuffInteger(bytesRead));
 293 return(nilCell);
 294 }
 295
 296 CELL * p_readFile(CELL * params)
 297 {
 298 char * fileName;
 299 char * buffer = NULL;
 300 CELL * cell;
 301 ssize_t size;
 302
 303 params = getString(params, &fileName);
 304 if(my_strnicmp(fileName, "http://", 7) == 0)
 305         return(getPutPostDeleteUrl(fileName, params, HTTP_GET_URL, 0));
 306
 307 if(my_strnicmp(fileName, "file://", 7) == 0)
 308         fileName = fileName + 7;
 309
 310 if((size = readFile(fileName, &buffer)) == -1)
 311         return(nilCell);
 312
 313 cell = getCell(CELL_STRING);
 314 cell->aux = size + 1;
 315 cell->contents = (UINT)buffer;
 316
 317 return(cell);
 318 }
 319
 320 /* allocate a buffer and reads a file into it */
 321 ssize_t readFile(char * fileName, char * * buffer)
 322 {
 323 int handle;
 324 size_t size;
 325 struct stat fileInfo;
 326
 327 #ifdef USE_WIN_UTF16PATH
 328 if(stat_utf16(fileName, &fileInfo) != 0)
 329 #else
 330 if(stat(fileName, &fileInfo) != 0)
 331 #endif
 332         return(-1);
 333
 334 size = fileInfo.st_size;
 335
 336 if( (handle = openFile(fileName, "r", NULL)) == (int)-1)
 337         return(-1);
 338
 339 *buffer = callocMemory(size+1);
 340
 341 if(read(handle, *buffer, size) == -1)
 342         {
 343         freeMemory(*buffer);
 344         close(handle);
 345         *buffer = NULL;
 346         return(-1);
 347         }
 348
 349 close(handle);
 350
 351 return(size);
 352 }
 353
 354
 355
 356 CELL * p_writeChar(CELL * params)
 357 {
 358 UINT handle;
 359 UINT data;
 360 size_t count;
 361 unsigned char chr;
 362
 363 params = getInteger(params, &handle);
 364 count = 0;
 365
 366 while(params != nilCell)
 367         {
 368         params = getInteger(params, &data);
 369         chr = (unsigned char)data;
 370         if(write((int)handle, (void *)&chr, 1) == -1)
 371                 return(nilCell);
 372         ++count;
 373         }
 374
 375 return(stuffInteger(count));
 376 }
 377
 378
 379 size_t appendCellString(CELL * cell, char * buffer, size_t size)
 380 {
 381 cell->contents = (UINT)reallocMemory((char *)cell->contents, cell->aux + size);
 382 memcpy((char *)cell->contents + cell->aux - 1, buffer, size);
 383 cell->aux += size;
 384
 385 *((char *)cell->contents + cell->aux - 1) = 0;
 386
 387 return(size);
 388 }
 389
 390
 391 CELL * p_writeBuffer(CELL * params)
 392 {
 393 UINT handle;
 394 ssize_t bytesWritten;
 395 size_t size;
 396 char * buffer;
 397 CELL * strCell;
 398 SYMBOL * writeSptr;
 399 CELL * cell;
 400 CELL * flagPtr = NULL;
 401
 402 cell = evalCheckProtected(params, &flagPtr);
 403
 404 params = params->next;
 405
 406 if(isNumber(cell->type))
 407         {
 408         getIntegerExt(cell, &handle, FALSE);
 409         cell = NULL;
 410         }
 411 else if(cell->type != CELL_STRING)
 412         return(errorProc(ERR_NUMBER_OR_STRING_EXPECTED));
 413
 414 strCell = evaluateExpression(params);
 415 if(strCell->type == CELL_SYMBOL)
 416     {
 417     writeSptr = (SYMBOL *)strCell->contents;
 418     strCell = (CELL *)writeSptr->contents;
 419     }
 420 else if(strCell->type == CELL_DYN_SYMBOL)
 421     {
 422     writeSptr = getDynamicSymbol(strCell);
 423     strCell = (CELL *)writeSptr->contents;
 424     }
 425
 426 if(strCell->type != CELL_STRING)
 427         return(errorProcExt(ERR_STRING_EXPECTED, params));
 428
 429 if(params->next == nilCell)
 430         size = strCell->aux - 1;
 431 else
 432         getInteger(params->next, (UINT *)&size);
 433
 434 buffer = (char *)strCell->contents;
 435 if(size > (strCell->aux - 1)) size = strCell->aux - 1;
 436
 437 if(cell != NULL)
 438         {
 439         if(flagPtr) return(errorProcExt(ERR_SYMBOL_PROTECTED, flagPtr));
 440         return(stuffInteger(appendCellString(cell, buffer, size)));
 441         }
 442
 443 if((bytesWritten = write((int)handle, buffer, size)) == (UINT)-1)
 444         return(nilCell);
 445
 446 return(stuffInteger(bytesWritten));
 447 }
 448
 449
 450 CELL * p_appendFile(CELL * params)
 451 {
 452 return(appendWriteFile(params, "a"));
 453 }
 454
 455 CELL * p_writeFile(CELL * params)
 456 {
 457 return(appendWriteFile(params, "w"));
 458 }
 459
 460
 461 CELL * appendWriteFile(CELL * params, char * type)
 462 {
 463 char * fileName;
 464 int handle;
 465 char * buffer;
 466 size_t size;
 467
 468 params = getString(params, &fileName);
 469
 470 if(my_strnicmp(fileName, "http://", 7) == 0)
 471         return(getPutPostDeleteUrl(fileName, params,
 472                                 (*type == 'w') ? HTTP_PUT_URL : HTTP_PUT_APPEND_URL, 0));
 473
 474 if(my_strnicmp(fileName, "file://", 7) == 0)
 475         fileName = fileName + 7;
 476
 477 getStringSize(params, &buffer, &size, TRUE);
 478
 479 if( (handle = openFile(fileName, type, NULL)) == (int)-1)
 480         return(nilCell);
 481
 482 if(write((int)handle, buffer, size) == -1)
 483         return(nilCell);
 484
 485 close(handle);
 486
 487 return(stuffInteger(size));
 488 }
 489
 490
 491 CELL * p_writeLine(CELL * params)
 492 {
 493 char * buffer;
 494 UINT handle;
 495 CELL * flagPtr = NULL;
 496 size_t size;
 497
 498 if(params->type == CELL_NIL)
 499         buffer = readLineStream.buffer;
 500 else
 501         params = getStringSize(params, &buffer, &size, TRUE);
 502
 503 if(params != nilCell)
 504         {
 505         params = evalCheckProtected(params, &flagPtr);
 506         if(isNumber(params->type))
 507                 {
 508                 getIntegerExt(params, &handle, FALSE);
 509                 if(write((int)handle, buffer, strlen(buffer)) == -1) return(nilCell);
 510                 if(write((int)handle, LINE_FEED, strlen(LINE_FEED)) == -1) return(nilCell);
 511                 }
 512         if(params->type == CELL_STRING)
 513                 {
 514         if(flagPtr) return(errorProcExt(ERR_SYMBOL_PROTECTED, flagPtr));
 515                 appendCellString(params, buffer, size);
 516                 appendCellString(params, LINE_FEED, strlen(LINE_FEED));
 517                 }
 518         }
 519 else
 520         {
 521         varPrintf(OUT_DEVICE, "%s", buffer);
 522         varPrintf(OUT_DEVICE, LINE_FEED);
 523         }
 524
 525 return(stuffString(buffer));
 526 }
 527
 528
 529 CELL * p_seek(CELL * params)
 530 {
 531 UINT handle;
 532 #ifdef LFS
 533 INT64 paramPosition;
 534 off_t newPosition;
 535 #else
 536 off_t paramPosition;
 537 off_t newPosition;
 538 #endif
 539
 540 params = getInteger(params, &handle);
 541
 542 if(params == nilCell)
 543         {
 544         if(handle == 0)
 545                 newPosition = ftell(stdout);
 546         else if( (newPosition = lseek(handle, 0, SEEK_CUR)) == -1)
 547                 return(nilCell);
 548         }
 549 else
 550         {
 551 #ifdef LFS
 552         getInteger64(params, &paramPosition);
 553 #else
 554         getInteger(params, (UINT *)&paramPosition);
 555 #endif
 556
 557         newPosition = paramPosition;
 558         if(newPosition == -1)
 559                 {
 560                 if( (newPosition = lseek((int)handle, 0, SEEK_END)) == -1)
 561                         return(nilCell);
 562                 }
 563         else
 564                 {
 565                 if( lseek((int)handle, newPosition, SEEK_SET) == -1)
 566                         return(nilCell);
 567                 }
 568         }
 569
 570 paramPosition = newPosition;
 571 #ifdef LFS
 572 return(stuffInteger64(paramPosition));
 573 #else
 574 return(stuffInteger(paramPosition));
 575 #endif
 576 }
 577
 578
 579 char * readStreamLine(STREAM * stream, FILE * inStream)
 580 {
 581 int chr;
 582
 583 openStrStream(stream, MAX_STRING, 1);
 584
 585 #ifdef TRU64
 586 do {
 587 errno = 0;
 588 #endif
 589 while((chr = fgetc(inStream)) != EOF)
 590         {
 591         if(chr == '\n') break;
 592         if(chr == '\r')
 593                 {
 594                 chr = fgetc(inStream);
 595                 if(chr == '\n' || chr == EOF) break;
 596                 }
 597         writeStreamChar(stream, chr);
 598         }
 599 #ifdef TRU64
 600 } while (errno == EINTR);
 601 #endif
 602
 603 if(chr == EOF && stream->position == 0) return(NULL);
 604 return(stream->buffer);
 605 }
 606
 607
 608 CELL * p_readLine(CELL * params)
 609 {
 610 UINT handle;
 611 unsigned char chr;
 612 char * line;
 613 int bytesRead;
 614
 615
 616 if(params != nilCell)
 617         getInteger(params, &handle);
 618 else
 619         handle = printDevice;
 620
 621 if(handle == 0)
 622         {
 623         if((line = readStreamLine(&readLineStream, IOchannel)) == NULL)
 624                 return(nilCell);
 625
 626         return(stuffString(line));
 627         }
 628
 629 openStrStream(&readLineStream, MAX_STRING, 1);
 630 while(TRUE)
 631         {
 632         if((bytesRead = read((int)handle, &chr, 1)) <= 0) break;
 633         if(chr == '\n') break;
 634         if(chr == '\r')
 635                 {
 636                 if(read((int)handle, &chr, 1) < 0) break;
 637                 if(chr == '\n') break;
 638                 }
 639         writeStreamChar(&readLineStream, chr);
 640         }
 641
 642 if(bytesRead <= 0 && readLineStream.position == 0)
 643         return(nilCell);
 644
 645 return(stuffString(readLineStream.buffer));;
 646 }
 647
 648
 649 CELL * p_currentLine(CELL * params)
 650 {
 651 return(stuffString(readLineStream.buffer));
 652 }
 653
 654
 655 int openFile(char * fileName, char * accessMode, char * option)
 656 {
 657 int blocking = 0;
 658
 659 #ifndef WIN_32
 660 if(option != NULL && *option == 'n')
 661         blocking = O_NONBLOCK;
 662 #endif
 663
 664 if(*accessMode == 'r')
 665         return(open(fileName, O_RDONLY | O_BINARY | blocking, 0));
 666
 667 else if(*accessMode == 'w')
 668 #ifdef WIN_32
 669     return(open( fileName, O_WRONLY | O_CREAT | O_TRUNC | O_BINARY, S_IREAD | S_IWRITE) );
 670 #else
 671     return(open(fileName,O_WRONLY | O_CREAT | O_TRUNC | O_BINARY | blocking,
 672         S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP | S_IWOTH)); /* rw-rw-rw */
 673 #endif
 674
 675 else if(*accessMode == 'u')
 676         return(open(fileName, O_RDWR | O_BINARY, 0));
 677
 678 else if(*accessMode == 'a')
 679        {
 680 #ifdef WIN_32
 681        return(open(fileName, O_RDWR | O_APPEND | O_BINARY | O_CREAT, S_IREAD | S_IWRITE));
 682 #else
 683        return(open(fileName, O_RDWR | O_APPEND | O_BINARY | O_CREAT,
 684           S_IRUSR | S_IRGRP | S_IROTH | S_IWUSR | S_IWGRP | S_IWOTH)); /* rw-rw-rw */
 685 #endif
 686        }
 687
 688 return(-1);
 689 }
 690
 691 /* ------------------------- directory management ------------------------- */
 692
 693 CELL * p_copyFile(CELL * params)
 694 {
 695 char * fromName;
 696 char * toName;
 697 int fromHandle, toHandle;
 698 unsigned char * copyBuffer;
 699 UINT bytesRead;
 700
 701 params = getString(params, &fromName);
 702 getString(params, &toName);
 703
 704 if((fromHandle = openFile(fromName, "read", NULL)) < 0)
 705         return(nilCell);
 706
 707 if((toHandle = openFile(toName,"write", NULL)) < 0)
 708         return(nilCell);
 709
 710 copyBuffer = allocMemory(MAX_FILE_BUFFER);
 711 do
 712         {
 713         bytesRead = read(fromHandle, copyBuffer, MAX_FILE_BUFFER);
 714         write(toHandle, copyBuffer, (int)bytesRead);
 715         } while (bytesRead == MAX_FILE_BUFFER);
 716
 717 free(copyBuffer);
 718
 719 close((int)fromHandle);
 720 close((int)toHandle);
 721
 722 return(trueCell);
 723 }
 724
 725
 726 CELL * p_renameFile(CELL * params)
 727 {
 728 char *oldName;
 729 char *newName;
 730
 731 params = getString(params, &oldName);
 732 getString(params, &newName);
 733 return(rename(oldName, newName) == 0 ? trueCell : nilCell);
 734 }
 735
 736
 737 CELL * p_deleteFile(CELL * params)
 738 {
 739 char * fileName;
 740
 741 params = getString(params, &fileName);
 742 if(my_strnicmp(fileName, "http://", 7) == 0)
 743         return(getPutPostDeleteUrl(fileName, params, HTTP_DELETE_URL, 0));
 744
 745 return(unlink(fileName) == 0 ? trueCell : nilCell);
 746 }
 747
 748
 749 CELL * p_makeDir(CELL * params)
 750 {
 751 char * dirString;
 752 mode_t mode;
 753 UINT inMode;
 754
 755 params = getString(params, &dirString);
 756 if(params != nilCell)
 757         {
 758         getInteger(params, &inMode);
 759         mode = inMode;
 760         }
 761 else
 762         mode = 0777; /* drwxrwxrwx  gets user masked to drwxr-xr-x on most UNIX */
 763
 764 #ifdef WIN_32
 765 return(mkdir(dirString) == 0 ? trueCell : nilCell);
 766 #else
 767 return(mkdir(dirString, (mode_t)mode) == 0 ? trueCell : nilCell);
 768 #endif
 769 }
 770
 771
 772 CELL * p_removeDir(CELL * params)
 773 {
 774 char * dirString;
 775
 776 getString(params, &dirString);
 777 return(rmdir(dirString) == 0 ? trueCell : nilCell);
 778 }
 779
 780
 781 CELL * p_changeDir(CELL * params)
 782 {
 783 char * newDir;
 784
 785 getString(params, &newDir);
 786 return(chdir(newDir) == 0 ? trueCell : nilCell);
 787 }
 788
 789 CELL * p_directory(CELL * params)
 790 {
 791 CELL * dirList;
 792 CELL * lastEntry;
 793 char * dirPath;
 794 char * fileName;
 795 char * pattern = NULL;
 796 UINT options = 0;
 797 DIR * dir;
 798 struct dirent * dEnt;
 799
 800 if(params != nilCell)
 801         {
 802         params = getString(params, &dirPath);
 803         if(params != nilCell)
 804                 {
 805                 params = getString(params, &pattern);
 806                 if(params != nilCell)
 807                         getInteger(params, &options);
 808                 }
 809         }
 810 else dirPath = ".";
 811
 812 dirList = getCell(CELL_EXPRESSION);
 813 lastEntry = NULL;
 814
 815 dir = opendir(dirPath);
 816 if(dir == NULL) return(nilCell);
 817
 818 while((dEnt = readdir(dir)) != NULL)
 819         {
 820 #ifdef USE_WIN_UTF16PATH
 821         fileName = utf16_to_utf8(dEnt->d_name);
 822 #else
 823         fileName = dEnt->d_name;
 824 #endif
 825         if(pattern)
 826                 {
 827                 if(searchBufferRegex(fileName, 0, pattern, strlen(fileName), options, NULL) == -1)
 828                         continue;
 829                 }
 830         if(lastEntry == NULL)
 831                 {
 832                 lastEntry = stuffString(fileName);
 833                 dirList->contents = (UINT)lastEntry;
 834                 }
 835         else
 836                 {
 837                 lastEntry->next = stuffString(fileName);
 838                 lastEntry = lastEntry->next;
 839                 }
 840 #ifdef USE_WIN_UTF16PATH
 841         free(fileName);
 842 #endif
 843         }
 844
 845 closedir(dir);
 846 return(dirList);
 847 }
 848
 849 #define DOT_PATH ".\000"
 850
 851 CELL * p_realpath(CELL * params)
 852 {
 853 char  path[PATH_MAX];
 854 char * dir;
 855
 856 if(params != nilCell)
 857         getString(params, &dir);
 858 else dir = DOT_PATH;
 859
 860 if(realpath(dir, path) == NULL)
 861         return(nilCell);
 862
 863 return(stuffString(path));
 864 }
 865
 866 CELL * p_fileInfo(CELL * params)
 867 {
 868 #ifdef USE_WIN_UTF16PATH
 869 WCHAR * pathName;
 870 struct _stat fileInfo;
 871 #else
 872 char * pathName;
 873 struct stat fileInfo;
 874 #endif
 875
 876 CELL * list;
 877
 878 #ifdef USE_WIN_UTF16PATH
 879 char * utf8pathName;
 880 params = getString(params, &utf8pathName);
 881 pathName = utf8_to_utf16(utf8pathName);
 882 #else
 883 params = getString(params, &pathName);
 884 #endif
 885
 886 if(lstat(pathName, &fileInfo) != 0)
 887         {
 888 #ifdef USE_WIN_UTF16PATH
 889         free(pathName);
 890 #endif
 891         return(nilCell);
 892         }
 893
 894 list = stuffIntegerList(
 895         8,
 896         (UINT)fileInfo.st_size,
 897         (UINT)fileInfo.st_mode,
 898         (UINT)fileInfo.st_rdev,
 899         (UINT)fileInfo.st_uid,
 900         (UINT)fileInfo.st_gid,
 901         (UINT)fileInfo.st_atime,
 902         (UINT)fileInfo.st_mtime,
 903         (UINT)fileInfo.st_ctime
 904         );
 905
 906 #ifndef NEWLISP64
 907 #ifdef LFS
 908 ((CELL *)list->contents)->type = CELL_INT64;
 909 #ifdef USE_WIN_UTF16PATH
 910 *(INT64 *)&((CELL *)list->contents)->aux = fileSizeW(pathName);
 911 #else
 912 *(INT64 *)&((CELL *)list->contents)->aux = fileSize(pathName);
 913 #endif /* UTF16PATH */
 914 #endif /* LFS */
 915 #endif /* NEWLISP64 */
 916
 917 #ifdef USE_WIN_UTF16PATH
 918 free(pathName);
 919 #endif
 920
 921 if(params != nilCell)
 922         {
 923         pushResult(list);
 924         return(copyCell(implicitIndexList(list, params)));
 925         }
 926
 927 return(list);
 928 }
 929
 930 #ifdef LFS
 931 INT64 fileSize(char * pathName)
 932 {
 933 int handle;
 934 INT64 size;
 935
 936 #ifndef WIN_32
 937 handle = open(pathName,O_RDONLY | O_BINARY | O_NONBLOCK , 0);
 938 #else
 939 handle = open(pathName,O_RDONLY | O_BINARY, 0);
 940 #endif
 941 size = lseek(handle, 0, SEEK_END);
 942 close(handle);
 943 if(size == -1) size = 0;
 944 return(size);
 945 }
 946 #endif
 947
 948
 949 /* ------------------------- processes and pipes ------------------------- */
 950
 951
 952 CELL * p_system(CELL *params)
 953 {
 954 char * command;
 955 getString(params, &command);
 956 return(stuffInteger((UINT)system(command)));
 957 }
 958
 959
 960 CELL * p_exec(CELL * params)
 961 {
 962 char * command, * data;
 963
 964 params = getString(params, &command);
 965 if(params == nilCell)
 966     return(readProcess(command));
 967
 968 getString(params, &data);
 969 return(writeProcess(command, data));
 970 }
 971
 972
 973 CELL * readProcess(char * command)
 974 {
 975 CELL * lineList;
 976 CELL * lastLine;
 977 FILE * handle;
 978 char * line;
 979
 980 lastLine = NULL;
 981
 982 if((handle = popen(command , "r")) == NULL)
 983         return(nilCell);
 984
 985 lineList = getCell(CELL_EXPRESSION);
 986 while((line = readStreamLine(&readLineStream, handle)) != NULL)
 987         {
 988         if(lastLine == NULL)
 989                 {
 990                 lastLine= stuffString(line);
 991                 lineList->contents = (UINT)lastLine;
 992                 }
 993         else
 994                 {
 995                 lastLine->next = stuffString(line);
 996                 lastLine = lastLine->next;
 997                 }
 998         }
 999 pclose(handle);
1000
1001 return(lineList);
1002 }
1003
1004
1005 CELL * writeProcess(char * command, char * data)
1006 {
1007 FILE * handle;
1008
1009 if((handle = popen(command, "w")) == NULL)
1010         return(nilCell);
1011
1012 if(fwrite(data, sizeof(char), strlen(data), handle) < strlen(data))
1013         return(nilCell);
1014
1015 pclose(handle);
1016 return(trueCell);
1017 }
1018
1019
1020 int init_argv(char * ptr, char *argv[])
1021 {
1022 int argc = 0;
1023 char brkChr;
1024
1025 while(*ptr != 0)
1026         {
1027         while(*ptr == ' ') ++ptr;
1028         if(*ptr == 0) break;
1029         if(*ptr == '\'' || *ptr == '"')
1030                 {
1031                 brkChr = *ptr;
1032                 argv[argc++] = ++ptr;
1033                 while(*ptr != brkChr && *ptr != 0) ++ptr;
1034                 if(*ptr == 0) break;
1035                 *ptr++ = 0;
1036                 continue;
1037                 }
1038         else
1039                 {
1040                 argv[argc++] = ptr++;
1041                 while(*ptr != ' ' && *ptr != 0) ptr++;
1042                 if(*ptr == 0) break;
1043                 *ptr++ = 0;
1044                 }
1045         }
1046
1047 argv[argc] = 0;
1048 return(argc);
1049 }
1050
1051
1052
1053 #ifdef WIN_32
1054 int winPipe(UINT * inpipe, UINT * outpipe);
1055 UINT winPipedProcess(char * command, int inpipe, int outpipe, int option);
1056 CELL * plainProcess(char * command, size_t size);
1057
1058 CELL * p_pipe(CELL * params)
1059 {
1060 UINT hin, hout;
1061
1062 if(!winPipe(&hin, &hout))    /* see file win32-util.c */
1063         return(nilCell);
1064
1065 return(stuffIntegerList(2, hin, hout));
1066 }
1067
1068
1069 CELL * p_process(CELL * params)
1070 {
1071 char * command;
1072 int result;
1073 size_t size;
1074
1075 UINT inpipe = 0, outpipe = 0, option = 1;
1076
1077 params = getStringSize(params, &command, &size, TRUE);
1078 if(params != nilCell)
1079         {
1080         params = getInteger(params, (UINT *)&inpipe);
1081         params = getInteger(params, (UINT *)&outpipe);
1082         if(params != nilCell)
1083                 getInteger(params, (UINT *)&option);
1084         }
1085 else return(plainProcess(command, size));
1086
1087 result = winPipedProcess(command, (int)inpipe, (int)outpipe, (int)option);
1088
1089 if(!result) return(nilCell);
1090
1091 return(stuffInteger(result));
1092 }
1093
1094 CELL * plainProcess(char * command, size_t len)
1095 {
1096 char * cPtr;
1097 char * argv[16];
1098 int idx;
1099
1100 cPtr = callocMemory(len + 1);
1101 memcpy(cPtr, command, len + 1);
1102
1103 #ifdef OLD_PP
1104 argv[0] = cPtr;
1105 for(idx = 1; idx < 5; idx++)
1106     {
1107     cPtr = strchr(cPtr, ' ');
1108     if(cPtr == NULL) break;
1109     while(*cPtr == ' ') *cPtr++ = 0;
1110     argv[idx] = cPtr;
1111     }
1112 argv[idx] = NULL;
1113 #endif
1114
1115 init_argv(cPtr, argv);
1116
1117 idx = spawnvp(P_NOWAIT, argv[0], (const char * const *)argv);
1118
1119 free(cPtr);
1120 if(idx == -1) return(nilCell);
1121
1122 return(stuffInteger(idx));
1123 }
1124
1125
1126 CELL * p_destroyProcess(CELL * params)
1127 {
1128 UINT pid;
1129
1130 getInteger(params, &pid);
1131
1132 if(TerminateProcess((HANDLE)pid, 0) == 0)
1133         return(nilCell);
1134
1135 return(trueCell);
1136 }
1137
1138
1139 #else /* not WIN_32 */
1140
1141 CELL * p_pipe(CELL * params)
1142 {
1143 int handles[2];
1144 if(pipe(handles) != 0)
1145         return(nilCell);
1146
1147 return(stuffIntegerList(2, (UINT)handles[0], (UINT)handles[1]));
1148 }
1149
1150
1151 CELL * p_process(CELL * params)
1152 {
1153 char * command;
1154 char * cmd;
1155 int forkResult;
1156 UINT inpipe = 0, outpipe = 0, errpipe = 0;
1157 char * argv[16];
1158 size_t  size;
1159
1160 params = getStringSize(params, &command, &size, TRUE);
1161 cmd = callocMemory(size + 1);
1162 memcpy(cmd, command, size + 1);
1163
1164 #ifdef DEBUG_INIT_ARGV
1165         int i;
1166         init_argv(cmd, argv);
1167         for(i = 0; i < 15; i++)
1168                 {
1169                 if(argv[i] == NULL) break;
1170                 printf("->%s<-\n", argv[i]);
1171                 }
1172         return(trueCell);
1173 #endif
1174
1175 if(params != nilCell)
1176         {
1177         params = getInteger(params, (UINT *)&inpipe);
1178         params = getInteger(params, (UINT *)&outpipe);
1179         if(params != nilCell)
1180                 getInteger(params, (UINT *)&errpipe);
1181         }
1182
1183 if((forkResult = fork()) == -1)
1184     return(nilCell);
1185 if(forkResult == 0)
1186     {
1187     /* redirect stdin and stdout, stderr to pipe handles */
1188     if(inpipe)
1189         {
1190         close(STDIN_FILENO);
1191         if(dup2((int)inpipe, STDIN_FILENO) == -1) exit(0);
1192         close((int)inpipe);
1193         }
1194     if(outpipe)
1195         {
1196         close(STDOUT_FILENO);
1197         if(dup2((int)outpipe, STDOUT_FILENO) == -1) exit(0);
1198         if(!errpipe)
1199             if(dup2((int)outpipe, STDERR_FILENO) == -1) exit(0);
1200         close((int)outpipe);
1201         }
1202     if(errpipe)
1203         {
1204         close(STDERR_FILENO);
1205         if(dup2((int)errpipe, STDERR_FILENO) == -1) exit(0);
1206         close((int)errpipe);
1207         }
1208
1209         init_argv(cmd, argv);
1210
1211         execve(argv[0], argv, environ);
1212         exit(0);
1213     }
1214
1215 return(stuffInteger(forkResult));
1216 }
1217
1218 CELL * p_fork(CELL * params)
1219 {
1220 int forkResult;
1221
1222 if((forkResult = fork()) == -1)
1223     return(nilCell);
1224 if(forkResult == 0)
1225     {
1226     evaluateExpression(params);
1227     exit(0);
1228     }
1229
1230 return(stuffInteger(forkResult));
1231 }
1232
1233 CELL * p_destroyProcess(CELL * params)
1234 {
1235 UINT pid;
1236 UINT sig;
1237
1238 params = getInteger(params, &pid);
1239 if(params != nilCell)
1240         getInteger(params, &sig);
1241 else
1242         sig = 9;
1243
1244 if(kill(pid, sig) != 0)
1245         return(nilCell);
1246
1247 return(trueCell);
1248 }
1249
1250 CELL * p_waitpid(CELL * params)
1251 {
1252 UINT pid, options;
1253 int result;
1254
1255 params = getInteger(params, (UINT *)&pid);
1256 if(params != nilCell)
1257         getInteger(params, (UINT *)&options);
1258 else
1259         options = 0;
1260
1261 waitpid((int)pid, &result, (int)options);
1262
1263 return(stuffInteger(result));
1264 }
1265
1266 #endif
1267
1268 /* ------------------------------ semaphores --------------------------------- */
1269
1270 #ifdef WIN_32
1271
1272 UINT winCreateSemaphore(void);
1273 UINT winWaitSemaphore(UINT hSemaphore);
1274 UINT winSignalSemaphore(UINT hSemaphore, int count);
1275 UINT winDeleteSemaphore(UINT hSemaphore);
1276 int getSemaphoreCount(UINT hSemaphore);
1277
1278 CELL * p_semaphore(CELL * params)
1279 {
1280 UINT sem_id;
1281 long value;
1282
1283 if(params != nilCell)
1284         {
1285         params = getInteger(params, &sem_id);
1286         if(params != nilCell)
1287                 {
1288                 getInteger(params,(UINT *)&value);
1289                 if(value == 0)
1290                         {
1291                         if(!winDeleteSemaphore(sem_id))
1292                                 return(nilCell);
1293                         return(trueCell);
1294                         }
1295
1296                 /* wait or signal */
1297                 if(value < 0)
1298                         {
1299                         if(winWaitSemaphore(sem_id)) return(trueCell);
1300                         return(nilCell);
1301                         }
1302                 if(value > 0)
1303                         {
1304                         if(winSignalSemaphore(sem_id, value)) return(trueCell);
1305                         return(nilCell);
1306                         }
1307                 }
1308
1309         else
1310                 {
1311                 /* return semaphore value, not on Win32 ? */
1312                 return(nilCell);
1313                 }
1314         }
1315
1316 /* create semaphore */
1317 if((sem_id = winCreateSemaphore()) == 0) return(nilCell);
1318 return(stuffInteger(sem_id));
1319 }
1320 #endif
1321
1322 #ifndef WIN_32
1323 /* only available on Linux/UNIX */
1324
1325
1326 CELL * p_semaphore(CELL * params)
1327 {
1328 UINT sem_id, value = 0;
1329 struct sembuf sem_b;
1330 #ifdef SOLARIS
1331 #ifndef NEWLISP64
1332 int semun_val = 0;
1333 #endif
1334 #endif
1335 #ifdef MAC_OSX
1336 union semun semu;
1337
1338 semu.val = 0;
1339 #endif
1340
1341 if(params != nilCell)
1342         {
1343         params = getInteger(params, (UINT*)&sem_id);
1344         if(params != nilCell)
1345                 {
1346                 getInteger(params,(UINT*)&value);
1347                 if(value == 0)
1348                         {
1349                         /* remove semaphore */
1350 #ifdef SOLARIS
1351
1352 #ifdef TRU64
1353                         if(semctl(sem_id, 0, IPC_RMID, 0) == -1)
1354 #else
1355 #ifndef NEWLISP64
1356                         if(semctl(sem_id, 0, IPC_RMID, &semun_val) == -1)
1357 #else
1358                         if(semctl(sem_id, 0, IPC_RMID, 0) == -1)
1359 #endif
1360 #endif /* SOLARIS */
1361
1362 #else
1363
1364 #ifdef MAC_OSX
1365                         if(semctl(sem_id, 0, IPC_RMID, semu) == -1)
1366 #else
1367                         if(semctl(sem_id, 0, IPC_RMID, 0) == -1)
1368 #endif
1369 #endif
1370                                 return(nilCell);
1371                         return(trueCell);
1372                         }
1373
1374                 /* wait or signal */
1375                 sem_b.sem_num = 0;
1376                 sem_b.sem_op = value;
1377                 sem_b.sem_flg = 0;
1378                 if(semop(sem_id, &sem_b, 1) == -1)
1379                         return(nilCell);
1380                 return(trueCell);
1381                 }
1382
1383         else
1384                 /* return semaphore value */
1385 #ifdef MAC_OSX
1386                 return(stuffInteger(semctl(sem_id, 0, GETVAL, semu)));
1387 #else
1388                 return(stuffInteger(semctl(sem_id, 0, GETVAL)));
1389 #endif
1390         }
1391
1392 /* create semaphore */
1393 sem_id = semget(IPC_PRIVATE, 1, 0666 );
1394 #ifdef SOLARIS
1395
1396 #ifdef TRU64
1397 if(semctl(sem_id, 0, SETVAL, 0) == -1)
1398 #else
1399 #ifndef NEWLISP64
1400 if(semctl(sem_id, 0, SETVAL, &semun_val) == -1)
1401 #else
1402 if(semctl(sem_id, 0, SETVAL, 0) == -1)
1403 #endif
1404 #endif
1405
1406 #else
1407
1408 #ifdef MAC_OSX
1409 if(semctl(sem_id, 0, SETVAL, semu) == -1)
1410 #else
1411 if(semctl(sem_id, 0, SETVAL, 0) == -1)
1412 #endif
1413
1414 #endif
1415         return(nilCell);
1416 return(stuffInteger(sem_id));
1417 }
1418
1419 #endif  /* not WIN_32 */
1420
1421
1422 union num_ptr {
1423         UINT num;
1424         UINT * ptr;
1425 };
1426
1427 #ifdef WIN_32
1428 UINT winSharedMemory(int size);
1429 UINT * winMapView(UINT handle, int size);
1430 #endif
1431
1432 #ifndef OS2
1433 CELL * p_share(CELL * params)
1434 {
1435 union num_ptr address;
1436 CELL * cell;
1437 size_t size;
1438 char * str;
1439 static int pagesize = 0;
1440
1441 #ifndef WIN_32
1442 if(!pagesize) pagesize = getpagesize();
1443 #else
1444 UINT handle;
1445 pagesize = 4096;
1446 #endif
1447
1448 if(params != nilCell)
1449         {
1450         cell = evaluateExpression(params);
1451 #ifndef WIN_32
1452         if(isNil(cell))
1453                 {
1454                 getInteger(params->next, &address.num);
1455                 if(munmap((void *)address.ptr, pagesize) == -1)
1456                         return(nilCell);
1457                 else return(trueCell);
1458                 }
1459 #endif
1460         getIntegerExt(cell, &address.num, FALSE);
1461         params = params->next;
1462 #ifdef WIN_32
1463         if((address.ptr = winMapView(address.num, pagesize)) == NULL)
1464                 return(nilCell);
1465 #endif
1466         if(params != nilCell) /* write to shared memory */
1467                 {
1468                 cell = evaluateExpression(params);
1469         if(cell->type == CELL_NIL)
1470                 {
1471                 *address.ptr = CELL_NIL;
1472 #ifdef WIN_32
1473                         UnmapViewOfFile(address.ptr);
1474 #endif
1475                 return(nilCell);
1476                 }
1477         if(cell->type == CELL_TRUE)
1478             {
1479             *address.ptr = CELL_TRUE;
1480 #ifdef WIN_32
1481                         UnmapViewOfFile(address.ptr);
1482 #endif
1483             return(trueCell);
1484             }
1485                 if(cell->type == CELL_STRING)
1486                         {
1487                         getStringSize(cell, &str, &size, FALSE);
1488                         if(size > (pagesize - 2 * sizeof(long) - 1))
1489                                 size = pagesize - 2 * sizeof(long) - 1;
1490                         *address.ptr = cell->type;
1491                         *(address.ptr + 1) = size;
1492                         memcpy((char *)(address.num + 2 * sizeof(long)), str, size);
1493                         *(char *)(address.num + 2 * sizeof(long) + size) = 0;
1494                         /* fall thru to address.ptr == CELL_STRING, to return sized string */
1495
1496                         goto return_new_string_cell;
1497                         }
1498                 if(cell->type == CELL_LONG)
1499                         {
1500                         *address.ptr = cell->type;
1501                         *(address.ptr + 1) = sizeof(long);
1502                         *(address.ptr + 2) = cell->contents;
1503 #ifdef WIN_32
1504                         UnmapViewOfFile(address.ptr);
1505 #endif
1506                         return(copyList(cell));
1507                         }
1508 #ifndef NEWLISP64
1509                 if(cell->type == CELL_INT64)
1510                         {
1511                         *address.ptr = cell->type;
1512                         *(address.ptr + 1) = sizeof(INT64);
1513                         memcpy(address.ptr + 2, (void *)&cell->aux, sizeof(INT64));
1514 #ifdef WIN_32
1515                         UnmapViewOfFile(address.ptr);
1516 #endif
1517                         return(copyList(cell));
1518                         }
1519                 if(cell->type == CELL_FLOAT)
1520                         {
1521                         *address.ptr = cell->type;
1522                         *(address.ptr + 1) = sizeof(double);
1523                         *(address.ptr + 2) = cell->aux;
1524                         *(address.ptr + 3) = cell->contents;
1525 #ifdef WIN_32
1526                         UnmapViewOfFile(address.ptr);
1527 #endif
1528                         return(copyList(cell));
1529                         }
1530
1531 #else /* NEWLISP64 */
1532                 if(cell->type == CELL_FLOAT)
1533                         {
1534                         *address.ptr = cell->type;
1535                         *(address.ptr + 1) = sizeof(double);
1536                         *(address.ptr + 2) = cell->contents;
1537                         return(copyList(cell));
1538                         }
1539 #endif /* NEWLISP64 */
1540                 return(errorProcExt(ERR_ILLEGAL_TYPE, cell));
1541                 }
1542         if(*address.ptr == CELL_NIL) /* rrad from share memory */
1543                 {
1544 #ifdef WIN_32
1545                 UnmapViewOfFile(address.ptr);
1546 #endif
1547         return(nilCell);
1548         }
1549     if(*address.ptr == CELL_TRUE)
1550         {
1551 #ifdef WIN_32
1552                 UnmapViewOfFile(address.ptr);
1553 #endif
1554         return(trueCell);
1555         }
1556         if(*address.ptr == CELL_LONG)
1557                 {
1558                 cell = stuffInteger(*(address.ptr + 2));
1559 #ifdef WIN_32
1560                 UnmapViewOfFile(address.ptr);
1561 #endif
1562                 return(cell);
1563                 }
1564 #ifndef NEWLISP64
1565         if(*address.ptr == CELL_INT64)
1566                 {
1567                 cell = stuffInteger64(*(INT64 *)(address.ptr + 2));
1568 #ifdef WIN_32
1569                 UnmapViewOfFile(address.ptr);
1570 #endif
1571                 return(cell);
1572                 }
1573 #endif
1574
1575         if(*address.ptr == CELL_FLOAT)
1576                 {
1577 #ifndef NEWLISP64
1578                 cell = getCell(CELL_FLOAT);
1579                 cell->aux = *(address.ptr + 2);
1580                 cell->contents = *(address.ptr + 3);
1581 #else
1582                 cell = getCell(CELL_FLOAT);
1583                 cell->contents = *(address.ptr + 2);
1584 #endif
1585 #ifdef WIN_32
1586                 UnmapViewOfFile(address.ptr);
1587 #endif
1588                 return(cell);
1589                 }
1590         if(*address.ptr == CELL_STRING)
1591                 {
1592 return_new_string_cell:
1593                 cell = getCell(CELL_STRING);
1594                 cell->aux = *(address.ptr + 1) + 1;
1595                 cell->contents = (UINT)allocMemory(cell->aux);
1596                 memcpy((char *)cell->contents, (char*)(address.num + 2 * sizeof(long)), cell->aux);
1597 #ifdef WIN_32
1598                 UnmapViewOfFile(address.ptr);
1599 #endif
1600                 return(cell);
1601                 }
1602         return(nilCell);
1603         }
1604
1605 #ifndef WIN_32
1606 if((address.ptr = (UINT*)mmap(
1607         0, pagesize, PROT_READ | PROT_WRITE, MAP_SHARED | MAP_ANON, -1, 0)) == (void*)-1)
1608                 return(nilCell);
1609
1610 memset((char *)address.num, 0, pagesize);
1611 return(stuffInteger(address.num));
1612
1613 #else
1614 if((handle = winSharedMemory(pagesize)) == 0)
1615         return(nilCell);
1616
1617 if((address.ptr = winMapView(handle, pagesize)) == NULL)
1618         return(nilCell);
1619
1620 memset((char *)address.num, 0, pagesize);
1621 return(stuffInteger(handle));
1622 #endif
1623 }
1624 #endif /* no OS2 */
1625
1626 /* ------------------------------ time and date functions -------------------- */
1627
1628 CELL * p_systemInfo(CELL * params)
1629 {
1630 CELL * cell;
1631
1632 cell = stuffIntegerList(
1633         8,
1634         cellCount,
1635         MAX_CELL_COUNT,
1636         symbolCount,
1637         (UINT)recursionCount,
1638         (UINT)envStackIdx,
1639         (UINT)MAX_CPU_STACK,
1640         (UINT)version,
1641         (UINT)opsys);
1642
1643 if(params != nilCell)
1644         {
1645         pushResult(cell);
1646         return(copyCell(implicitIndexList(cell, params)));
1647         }
1648
1649 return(cell);
1650 }
1651
1652
1653 CELL * p_systemError(CELL * params)
1654 {
1655 UINT init;
1656
1657 if(params != nilCell)
1658         {
1659         getInteger(params, (UINT*)&init);
1660         errno=(int)init;
1661         }
1662
1663 return(stuffInteger((UINT)errno));
1664 }
1665
1666
1667 CELL * p_date(CELL * params)
1668 {
1669 time_t t;
1670 struct timeval tv;
1671 struct tm * ltm;
1672 char * ct;
1673 char * fmt;
1674 ssize_t offset;
1675 ssize_t tme;
1676
1677 #ifdef SUPPORT_UTF8
1678 #ifdef WCSFTIME
1679 int * ufmt;
1680 int * timeString;
1681 int size;
1682 #endif
1683 char * utf8str;
1684 #else
1685 char * timeString;
1686 #endif
1687
1688 if(params == nilCell)
1689         {
1690         gettimeofday(&tv, NULL);
1691         t = tv.tv_sec;
1692         }
1693 else
1694         {
1695         params = getInteger(params, (UINT *)&tme);
1696         t = tme;
1697
1698         if(params != nilCell)
1699                 {
1700                 params = getInteger(params, (UINT *)&offset);
1701                 t += (int)offset * 60;
1702                 }
1703
1704         if(params != nilCell)
1705                 {
1706                 params = getString(params, &fmt);
1707                 ltm = localtime(&t);
1708 #ifdef SUPPORT_UTF8
1709         /* some Linux do UTF-8 but don't have wcsftime() or it is buggy */
1710 #ifdef WCSFTIME
1711                 size = utf8_wlen(fmt);
1712                 ufmt = alloca(UTF8_MAX_BYTES * (size + 1));
1713                 utf8_wstr(ufmt, fmt, size);
1714
1715                 timeString = alloca(UTF8_MAX_BYTES * 128);
1716                 size = wcsftime((wchar_t *)timeString, 127, (wchar_t *)ufmt, ltm);
1717                 utf8str = alloca(size * UTF8_MAX_BYTES + 1);
1718                 size =  wstr_utf8(utf8str, timeString, size * UTF8_MAX_BYTES);
1719                 return(stuffString(utf8str));
1720 #else
1721                 utf8str = alloca(128);
1722                 strftime(utf8str, 127, fmt, ltm);
1723                 return(stuffString(utf8str));
1724 #endif /* WCSFTIME */
1725
1726 #else
1727                 timeString = alloca(128);
1728                 strftime(timeString, 127, fmt, ltm);
1729                 return(stuffString(timeString));
1730 #endif
1731                 }
1732         }
1733
1734 ct = ctime(&t);
1735 if(ct == NULL) return(nilCell);
1736
1737 ct[strlen(ct) - 1] = 0;  /* supress linefeed */
1738 return(stuffString(ct));
1739 }
1740
1741
1742 int milliSecTime(void)
1743 {
1744 struct timeval tv;
1745 struct tm * ttm;
1746
1747 gettimeofday(&tv, NULL);
1748
1749 ttm = localtime((time_t *)&tv.tv_sec);
1750
1751 return (ttm->tm_hour * 3600000 +
1752        ttm->tm_min * 60000 + ttm->tm_sec * 1000 +
1753        tv.tv_usec/1000);
1754 }
1755
1756
1757 /* returns a differerence of 2 timeval structs in milliseconds
1758 */
1759 int timediff(struct timeval out, struct timeval in )
1760 {
1761         if( (out.tv_usec -= in.tv_usec) < 0 )   {
1762                 out.tv_sec--;
1763                 out.tv_usec += 1000000;
1764         }
1765         out.tv_sec -= in.tv_sec;
1766
1767 return(out.tv_sec*1000 + (out.tv_usec/1000));
1768 }
1769
1770 UINT64 timediff64(struct timeval out, struct timeval in )
1771 {
1772         if( (out.tv_usec -= in.tv_usec) < 0 )   {
1773                 out.tv_sec--;
1774                 out.tv_usec += 1000000;
1775         }
1776         out.tv_sec -= in.tv_sec;
1777
1778 return(out.tv_sec*1000000 + out.tv_usec);
1779 }
1780
1781 #ifndef WIN_32
1782 CELL * p_parseDate(CELL * params)
1783 {
1784 struct tm ttm;
1785 char * dateStr;
1786 char * formatStr;
1787 size_t dateValue;
1788
1789 params = getString(params, &dateStr);
1790 params = getString(params, &formatStr);
1791
1792 memset (&ttm, 0, sizeof (ttm));
1793
1794 if(strptime(dateStr, formatStr, &ttm) == NULL)
1795         return(nilCell);
1796
1797 dateValue = calcDateValue(
1798                 ttm.tm_year + 1900,
1799                 ttm.tm_mon + 1,
1800                 ttm.tm_mday,
1801                 ttm.tm_hour,
1802                 ttm.tm_min,
1803                 ttm.tm_sec);
1804
1805 return(stuffInteger(dateValue));
1806 }
1807 #endif
1808
1809 CELL * p_time(CELL * params)
1810 {
1811 struct timeval start, end;
1812 INT64 N = 1;
1813 int resultIdxSave;
1814
1815 gettimeofday(&start, NULL);
1816 if(params->next != nilCell)
1817     getInteger64(params->next, &N);
1818
1819 resultIdxSave = resultStackIdx;
1820 while(N--)
1821     {
1822     evaluateExpression(params);
1823     cleanupResults(resultIdxSave);
1824     }
1825
1826 gettimeofday(&end, NULL);
1827 return(stuffInteger((UINT)timediff(end, start)));
1828 }
1829
1830
1831 CELL * p_timeOfDay(CELL * params)
1832 {
1833 return(stuffInteger(milliSecTime()));
1834 }
1835
1836 CELL * p_now(CELL * params)
1837 {
1838 struct timeval tv;
1839 struct tm *ttm;
1840 struct tm *ltm;
1841 struct timezone tzp;
1842 ssize_t offset;
1843
1844 gettimeofday(&tv, &tzp);
1845
1846 if(params != nilCell)
1847         {
1848         getInteger(params, (UINT*)&offset);
1849         offset *= 60;
1850         tv.tv_sec += offset;
1851         }
1852
1853 ltm = localtime((time_t *)&tv.tv_sec);
1854
1855 ttm = gmtime((time_t *)&tv.tv_sec);
1856
1857 return(stuffIntegerList(
1858     11,
1859     (UINT)ttm->tm_year + 1900,
1860     (UINT)ttm->tm_mon + 1,
1861     (UINT)ttm->tm_mday,
1862     (UINT)ttm->tm_hour,
1863     (UINT)ttm->tm_min,
1864     (UINT)ttm->tm_sec,
1865     (UINT)tv.tv_usec,
1866     (UINT)ttm->tm_yday + 1,
1867     (UINT)ttm->tm_wday + 1,
1868 /* Note, that on SOLARIS tzp.tz_minuteswest and
1869    tzp.tz_dsttime might not work correctly
1870    and contain garbage
1871 */
1872     (UINT)tzp.tz_minuteswest,
1873 #ifdef WIN_32
1874 /*    (UINT)ltm->tm_isdst */
1875     (UINT)tzp.tz_dsttime
1876 #else
1877     (UINT)ltm->tm_isdst
1878 #endif
1879     ));
1880 }
1881
1882
1883 UINT seconds(void)
1884 {
1885 struct timeval tv;
1886
1887 gettimeofday(&tv, NULL);
1888 return(tv.tv_sec);
1889 }
1890
1891
1892 CELL * p_dateValue(CELL * params)
1893 {
1894 struct timeval tv;
1895 ssize_t year, month, day, hour, min, sec;
1896 size_t dateValue;
1897
1898 if(params->type == CELL_NIL)
1899         {
1900         gettimeofday(&tv, NULL);
1901         return(stuffInteger(tv.tv_sec));
1902         }
1903
1904 params = getInteger(params, (UINT *)&year);
1905 params = getInteger(params, (UINT *)&month);
1906 params = getInteger(params, (UINT *)&day);
1907
1908 if(year < 1970) return(stuffInteger(0));
1909
1910 hour = min = sec = 0;
1911 if(params != nilCell)
1912         {
1913         params = getInteger(params, (UINT *)&hour);
1914         params = getInteger(params, (UINT *)&min);
1915         getInteger(params, (UINT *)&sec);
1916         }
1917
1918 dateValue = calcDateValue(year, month, day, hour, min, sec);
1919
1920 return(stuffInteger((UINT)dateValue));
1921 }
1922
1923
1924 size_t calcDateValue(int year, int month, int day, int hour, int min, int sec)
1925 {
1926 size_t dateValue;
1927
1928 dateValue = 367 * year - (7 * (year + ((month + 9) / 12)))/4
1929             + (275 * month)/9 + day + 1721013;
1930
1931 dateValue = dateValue * 24 * 3600 + hour * 3600 + min * 60 + sec
1932             - 413319296; /* correction for 1970-1-1 */
1933
1934 #ifdef NEWLISP64
1935 dateValue = dateValue % 0x80000000;
1936 #endif
1937
1938 return(dateValue);
1939 }
1940
1941
1942 #ifdef MAC_OSX
1943 extern int nanosleep();
1944 #endif
1945
1946 void mySleep(int ms)
1947 {
1948 #ifdef NANOSLEEP
1949 struct timespec tm;
1950
1951 tm.tv_sec = ms / 1000;
1952 tm.tv_nsec = (ms - tm.tv_sec * 1000) * 1000000;
1953 nanosleep(&tm, 0);
1954
1955 #else
1956
1957 #ifdef WIN_32
1958 /* _sleep() is deprecated in MinGW gcc 3.4.5 */
1959 Sleep(ms);
1960 #else
1961 sleep((ms + 500)/1000);
1962 #endif
1963
1964 #endif
1965 }
1966
1967
1968 CELL * p_sleep(CELL * params)
1969 {
1970 size_t milliSecs;
1971
1972 getInteger(params, (UINT *)&milliSecs);
1973
1974 mySleep(milliSecs);
1975
1976 return(stuffInteger((UINT)milliSecs));
1977 }
1978
1979 /* -------------------------------- environment functions ------------------- */
1980
1981
1982 CELL * p_env(CELL * params)
1983 {
1984 char * varName;
1985 char * varValue;
1986
1987 /* no parameters returns whole environment */
1988 if(params == nilCell)
1989         return(environment());
1990
1991 /* one parameter get environment for one variable */
1992 params = getString(params, &varName);
1993 if(params == nilCell)
1994         {
1995         if( (varValue = getenv(varName)) == NULL)
1996                 return(nilCell);
1997         return(stuffString(varValue));
1998         }
1999
2000 /* two parameters sets environment for one variable */
2001 getString(params, &varValue);
2002 #ifndef MY_SETENV
2003 if(*varValue == 0)
2004         unsetenv(varName);
2005 else
2006 #endif
2007         if(setenv(varName, varValue, 1) != 0)
2008                 return(nilCell);
2009
2010 return(trueCell);
2011 }
2012
2013
2014 #ifdef MY_SETENV
2015 int my_setenv(const char * varName, const char * varValue, int flag)
2016 {
2017 char * envstr;
2018 envstr = alloca(strlen(varName) + strlen(varValue) + 2);
2019 strcpy(envstr, varName);
2020 strcat(envstr, "=");
2021 strcat(envstr, varValue);
2022 return(putenv(envstr));
2023 }
2024 #endif
2025
2026
2027 CELL * environment(void)
2028 {
2029 char ** env;
2030 CELL * envList;
2031 CELL * lastEntry;
2032
2033 lastEntry = NULL;
2034 envList = getCell(CELL_EXPRESSION);
2035
2036 #ifdef MAC_OSX
2037 #ifdef LIBRARY
2038 return(envList);
2039 #endif
2040 #endif
2041
2042 env = environ;
2043
2044 while(*env)
2045         {
2046         if(lastEntry == NULL)
2047                 {
2048                 lastEntry = stuffString(*env);
2049                 envList->contents = (UINT)lastEntry;
2050                 }
2051         else
2052                 {
2053                 lastEntry->next = stuffString(*env);
2054                 lastEntry = lastEntry->next;
2055                 }
2056         env++;
2057         }
2058
2059 return(envList);
2060 }
2061
2062 /* --------------------- read the keyboard -----------------------------------*/
2063
2064 /* thanks to Peter van Eerten for contributing this function */
2065 CELL * p_readKey(CELL * params)
2066 {
2067 #ifdef WIN_32
2068 return(stuffInteger(getch()));
2069 #else
2070 #ifdef OS2
2071 return(stuffInteger(getch()));
2072 #else
2073
2074 struct termios term, oterm;
2075 char c = 0;
2076
2077 tcgetattr(0, &oterm);
2078
2079 memcpy(&term, &oterm, sizeof(term));
2080
2081 /* put the terminal in non-canonical mode, any
2082 reads timeout after 0.1 seconds or when a
2083 single character is read */
2084 term.c_lflag &= ~(ICANON | ECHO);
2085 term.c_cc[VMIN] = 0;
2086 term.c_cc[VTIME] = 1;
2087 tcsetattr(0, TCSANOW, &term);
2088
2089 #if defined  (_BSD) || (MAC_OSX)
2090 while(read(0, &c, 1) == 0);
2091 #else
2092 while((c = (char)getchar()) == (char)-1);
2093 #endif
2094
2095 /* reset the terminal to original state */
2096 tcsetattr(0, TCSANOW, &oterm);
2097
2098 return(stuffInteger(c));
2099 #endif
2100 #endif
2101 }
2102
2103 /* --------------------- peek a file descriptor ------------------------------*/
2104 #ifndef WIN_32
2105 CELL * p_peek(CELL * params)
2106 {
2107 UINT handle;
2108 #ifdef WIN_32
2109 unsigned long result;
2110 #else
2111 int result;
2112 #endif
2113
2114 getInteger(params, &handle);
2115
2116 if(ioctl((int)handle, FIONREAD, &result) < 0)
2117         return(nilCell);
2118
2119 return(stuffInteger((UINT)result));
2120 }
2121 #endif
2122
2123
2124 /* --------------------- library functions not found on some OSs -------------*/
2125
2126 #ifdef MY_VASPRINTF
2127
2128 int my_vasprintf(char * * buffer, const char * format, va_list argptr)
2129 {
2130 ssize_t size = MAX_STRING;
2131 ssize_t pSize;
2132
2133 while(TRUE)
2134         {
2135         *buffer = allocMemory(size + 2);
2136         pSize = vsnprintf(*buffer, size + 1, format, argptr);
2137
2138 #if defined(WIN_32) || defined(TRU64)
2139         if(pSize < 0)
2140                 {
2141                 freeMemory(*buffer);
2142                 size = size + size / 2;
2143                 continue;
2144                 }
2145 #else
2146         if(pSize > size)
2147                 {
2148                 freeMemory(*buffer);
2149                 size = pSize;
2150                 continue;
2151                 }
2152 #endif
2153         break;
2154         }
2155
2156 return((int)pSize);
2157 }
2158
2159 #endif
2160
2161 /* ---------------------- Universal Unique ID version 1 and 3 ----------- */
2162
2163 #define UINT16 unsigned short
2164 #define UINT32 unsigned int
2165
2166 typedef struct
2167         {
2168         UINT32          time_low;
2169         UINT16          time_mid;
2170         UINT16          time_hi_and_version;
2171         unsigned char   clock_seq_hi_and_reserved;
2172         unsigned char   clock_seq_low;
2173         unsigned char   node[6];
2174         } UUID;
2175
2176 UINT16 clock_seq = 0;
2177 INT64 last_time = 0;
2178 char last_node[6];
2179
2180 #define OCT151582 0x01B21DD213814000LL
2181
2182 int getUUID(UUID * uuid, char * node)
2183 {
2184 struct timeval tp;
2185 INT64 timestamp;
2186 UINT16 nodeID[3];
2187 int uuid_version;
2188
2189 gettimeofday(&tp, (struct timezone *)0);
2190
2191 /* add UUID UTC offset Oct 15, 1582 */
2192 timestamp = tp.tv_sec * (INT64)10000000 + tp.tv_usec * 10 + OCT151582;
2193
2194 #ifdef WIN_32
2195 if(timestamp <= last_time) timestamp = last_time + 1;
2196 #else
2197 if(timestamp < last_time) clock_seq++;
2198 if(timestamp == last_time) timestamp++;
2199 #endif
2200
2201 if(last_time == 0)
2202         srandom((timestamp & 0xFFFFFFFF) + getpid());
2203
2204 last_time = timestamp;
2205
2206
2207 if(clock_seq == 0) clock_seq = random();
2208 if(node != NULL && (memcmp(last_node, node, 6) != 0))
2209         {
2210         clock_seq = random();
2211         memcpy(last_node, node, 6);
2212         }
2213
2214 if(node == NULL)
2215         {
2216         nodeID[0] = random();
2217         nodeID[1] = random();
2218         nodeID[2] = random();
2219         uuid_version = 4;
2220         memcpy(uuid->node, (void *)nodeID, 6);
2221         }
2222 else
2223         {
2224         uuid_version = 1;
2225         /* least sign bit of first byte must be 0 on MACs
2226        and 1 on artifical generated node IDs */
2227         memcpy(uuid->node, node, 6);
2228         }
2229
2230 if(uuid_version == 4)
2231         {
2232         clock_seq = random();
2233         uuid->time_low = random();
2234 #ifdef WIN_32
2235         uuid->time_low |= (random() << 16);
2236 #endif
2237         uuid->time_mid = random();
2238         uuid->time_hi_and_version = random();
2239         }
2240 else
2241         {
2242         uuid->time_low = (unsigned long)(timestamp & 0xFFFFFFFF);
2243         uuid->time_mid = (unsigned short)((timestamp >> 32) & 0xFFFF);
2244         uuid->time_hi_and_version = (unsigned short)(timestamp >> 48) ;
2245         }
2246
2247 uuid->time_hi_and_version &= 0x0FFF;
2248 uuid->time_hi_and_version |= (uuid_version << 12);
2249 uuid->clock_seq_low = clock_seq & 0xFF;
2250 uuid->clock_seq_hi_and_reserved = (clock_seq & 0x3F00) >> 8;
2251 uuid->clock_seq_hi_and_reserved |= 0x80;
2252
2253 return(1);
2254 }
2255
2256 CELL * p_uuid(CELL * params)
2257 {
2258 UUID uuid;
2259 char * nodeMAC = NULL;
2260 size_t size;
2261 char str[38];
2262
2263 if(params != nilCell)
2264         {
2265         getStringSize(params, &nodeMAC, &size, TRUE);
2266         if(size < 6) nodeMAC = NULL;
2267         }
2268
2269 getUUID(&uuid, nodeMAC);
2270
2271 snprintf(str, 37, "%08X-%04X-%04X-%02X%02X-%02X%02X%02X%02X%02X%02X",
2272         uuid.time_low, uuid.time_mid, uuid.time_hi_and_version,
2273         uuid.clock_seq_hi_and_reserved, uuid.clock_seq_low,
2274         uuid.node[0], uuid.node[1], uuid.node[2],
2275         uuid.node[3], uuid.node[4], uuid.node[5]);
2276
2277 return(stuffString(str));
2278 }
2279
2280 /* eof */
2281