Description: TODO: Put a short summary on the line above and replace this paragraph with a longer explanation of this change. Complete the meta-information with other relevant fields (see below for details). To make it easier, the information below has been extracted from the changelog. Adjust it or drop it. . gcl (2.6.12-39) unstable; urgency=medium . * pathnames1.1 * ansi-test clean target Author: Camm Maguire --- The information above should follow the Patch Tagging Guidelines, please checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here are templates for supplementary fields that you might want to add: Origin: , Bug: Bug-Debian: https://bugs.debian.org/ Bug-Ubuntu: https://launchpad.net/bugs/ Forwarded: Reviewed-By: Last-Update: 2016-10-12 --- gcl-2.6.12.orig/h/notcomp.h +++ gcl-2.6.12/h/notcomp.h @@ -296,6 +296,8 @@ gcl_init_cmp_anon(void); char FN1[PATH_MAX],FN2[PATH_MAX],FN3[PATH_MAX],FN4[PATH_MAX],FN5[PATH_MAX]; +#define coerce_to_filename(a_,b_) coerce_to_filename1(a_,b_,sizeof(b_)) + #include #define massert(a_) ({errno=0;if (!(a_)||errno) assert_error(#a_,__LINE__,__FILE__,__FUNCTION__);}) --- gcl-2.6.12.orig/h/protoize.h +++ gcl-2.6.12/h/protoize.h @@ -508,7 +508,7 @@ typedef void (*funcvoid)(void); /* unexlin.c:808:OF */ extern int write_segment (int new, register char *ptr, register char *end); /* (new, ptr, end) int new; register char *ptr; register char *end; */ /* unixfasl.c:409:OF */ extern void gcl_init_unixfasl (void); /* () */ /* unixfsys.c:145:OF */ extern char *getwd (char *buffer); /* (buffer) char *buffer; */ -/* unixfsys.c:209:OF */ extern void coerce_to_filename (object pathname, char *p); /* (pathname, p) object pathname; char *p; */ +/* unixfsys.c:209:OF */ extern void coerce_to_filename1 (object pathname, char *p,unsigned sz); /* (pathname, p) object pathname; char *p; */ /* unixfsys.c:329:OF */ extern bool file_exists (object file); /* (file) object file; */ /* unixfsys.c:359:OF */ extern FILE *backup_fopen (char *filename, char *option); /* (filename, option) char *filename; char *option; */ /* unixfsys.c:359:OF */ extern FILE *fopen_not_dir (char *filename, char *option); /* (filename, option) char *filename; char *option; */ --- gcl-2.6.12.orig/lsp/gcl_directory.lsp +++ gcl-2.6.12/lsp/gcl_directory.lsp @@ -48,8 +48,12 @@ (expand-wild-directory (cons :relative (cdr x)) f q e)) :directory));FIXME ((funcall f z y)))))) +(defun chdir (s) + (when (chdir1 (namestring (pathname s)));to expand ~/ + (setq *current-directory* (current-directory-pathname)))) + (defun directory (p &key &aux (p (translate-logical-pathname p))(d (pathname-directory p)) - (c (unless (eq (car d) :absolute) (make-frame (concatenate 'string (getcwd) "/")))) + (c (unless (eq (car d) :absolute) (make-frame (namestring *current-directory*)))) (lc (when c (length c))) (filesp (or (pathname-name p) (pathname-type p))) (v (compile-regexp (to-regexp p)))(*up-key* :back) r) --- gcl-2.6.12.orig/lsp/gcl_rename_file.lsp +++ gcl-2.6.12/lsp/gcl_rename_file.lsp @@ -35,6 +35,7 @@ (check-type spec pathname-designator) (multiple-value-bind (tp sz tm) (stat (namestring (truename spec))) + (declare (ignore tp sz)) (+ tm (* (+ 17 (* 70 365)) (* 24 60 60))))) @@ -43,5 +44,6 @@ (check-type spec pathname-designator) (multiple-value-bind (tp sz tm uid) (stat (namestring (truename spec))) + (declare (ignore tp sz tm)) (uid-to-name uid))) --- gcl-2.6.12.orig/lsp/gcl_top.lsp +++ gcl-2.6.12/lsp/gcl_top.lsp @@ -607,8 +607,13 @@ First directory is checked for first nam (defvar *ld* "ld") (defvar *objdump* "objdump --source ") +(defvar *current-directory* *system-directory*) + +(defun current-directory-pathname nil (pathname (concatenate 'string (getcwd) "/"))) + (defun set-up-top-level (&aux (i (argc)) tem) (declare (fixnum i)) + (setq *current-directory* (current-directory-pathname)) (setq *tmp-dir* (get-temp-dir) *cc* (get-path *cc*) *ld* (get-path *ld*) --- gcl-2.6.12.orig/lsp/gcl_truename.lsp +++ gcl-2.6.12/lsp/gcl_truename.lsp @@ -18,20 +18,18 @@ (pathname (typep x 'logical-pathname)) (stream (logical-pathname-designator-p (pathname x))))) -;(defvar *current-dir* (pathname (concatenate 'string (getcwd) "/"))) FIXME sync with chdir - -(defun truename (pd &aux (ppd (translate-logical-pathname pd))(ns (namestring ppd))) +(defun truename (pd &aux (ns (namestring (translate-logical-pathname pd)))) (declare (optimize (safety 1))) (check-type pd pathname-designator) (when (wild-pathname-p ns) (error 'file-error :pathname pd :format-control "Pathname is wild")) - (let* ((ns (ensure-dir-string (link-expand ns)))) + (let* ((ns (ensure-dir-string (link-expand ns)))(ppd (pathname ns))) (unless (or (zerop (length ns)) (stat ns)) (error 'file-error :pathname ns :format-control "Pathname does not exist")) (let* ((d (pathname-directory ppd)) (d1 (subst :back :up d)) (ppd (if (eq d d1) ppd (make-pathname :directory d1 :defaults ppd)))) - (if (eq (car d) :absolute) ppd (merge-pathnames ppd (concatenate 'string (getcwd) "/") nil))))) + (if (eq (car d) :absolute) ppd (merge-pathnames ppd *current-directory* nil))))) (defun probe-file (pd &aux (pn (translate-logical-pathname pd))) --- gcl-2.6.12.orig/o/file.d +++ gcl-2.6.12/o/file.d @@ -351,120 +351,86 @@ open_stream(object fn,enum smmode smm, o vs_mark; coerce_to_filename(fn,FN1); - if (smm == smm_input || smm == smm_probe) { - if(FN1[0]=='|') - fp = popen(FN1+1,"r"); - else - fp = fopen_not_dir(FN1, "r"); - if ((fp == NULL) && - (sSAallow_gzipped_fileA->s.s_dbind != sLnil)) { - union lispunion st; - char buf[256]; - if (snprintf(buf,sizeof(buf),"%s.gz",FN1)<=0) - FEerror("Cannot write .gz filename",0); - st.st.st_self=buf; - st.st.st_dim=st.st.st_fillp=strlen(buf); - set_type_of(&st,t_string); - if (fSstat((object)&st)!=Cnil) { + switch(smm) { + + case smm_input: + case smm_probe: + + if (!(fp=*FN1=='|' ? popen(FN1+1,"r") : fopen_not_dir(FN1,"r")) && sSAallow_gzipped_fileA->s.s_dbind!=Cnil) { + + struct stat ss; + massert(snprintf(FN2,sizeof(FN2),"%s.gz",FN1)>0); + + if (!stat(FN2,&ss)) { + FILE *pp; int n; - if (!(fp=tmpfile())) - FEerror("Cannot create temporary file",0); - if (snprintf(buf,sizeof(buf),"zcat %s.gz",FN1)<=0) - FEerror("Cannot write zcat pipe name",0); - if (!(pp=popen(buf,"r"))) - FEerror("Cannot open zcat pipe",0); - while((n=fread(buf,1,sizeof(buf),pp))) - if (!fwrite(buf,1,n,fp)) - FEerror("Cannot write pipe output to temporary file",0); - if (pclose(pp)<0) - FEerror("Cannot close zcat pipe",0); - if (fseek(fp,0,SEEK_SET)) - FEerror("Cannot rewind temporary file\n",0); + + massert((fp=tmpfile())); + massert(snprintf(FN3,sizeof(FN2),"zcat %s",FN2)>0); + massert(pp=popen(FN3,"r")); + while ((n=fread(FN4,1,sizeof(FN3),pp))) + massert(fwrite(FN4,1,n,fp)==n); + massert(pclose(pp)>=0); + massert(!fseek(fp,0,SEEK_SET)); + } + } - if (fp == NULL) { - if (if_does_not_exist == sKerror) - cannot_open(fn); - else if (if_does_not_exist == sKcreate) { - fp = fopen_not_dir(FN1, "w"); - if (fp == NULL) - cannot_create(fn); + + if (!fp) { + + if (if_does_not_exist==sKerror) cannot_open(fn); + else if (if_does_not_exist==sKcreate) { + if (!(fp=fopen_not_dir(FN1,"w"))) cannot_create(fn); fclose(fp); - fp = fopen_not_dir(FN1, "r"); - if (fp == NULL) - cannot_open(fn); - } else if (if_does_not_exist == Cnil) - return(Cnil); - else - FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", - 1, if_does_not_exist); + if (!(fp=fopen_not_dir(FN1,"r"))) cannot_open(fn); + } else if (if_does_not_exist==Cnil) return(Cnil); + else FEerror("~S is an illegal IF-DOES-NOT-EXIST option.",1,if_does_not_exist); + } - } else if (smm == smm_output || smm == smm_io) { - if (FN1[0] == '|') - fp = NULL; - else - fp = fopen_not_dir(FN1, "r"); - if (fp != NULL) { + break; + + case smm_output: + case smm_io: + + if ((fp=*FN1=='|' ? NULL : fopen_not_dir(FN1,"r"))) { + fclose(fp); - if (if_exists == sKerror) - FILE_ERROR(fn,"File exists"); - else if (if_exists == sKrename) { + if (if_exists==sKerror) FILE_ERROR(fn,"File exists"); + else if (if_exists==sKrename) { massert(snprintf(FN2,sizeof(FN2),"%s.BAK",FN1)>=0); massert(!rename(FN1,FN2)); - if (smm == smm_output) - fp = fopen(FN1, "w"); - else - fp = fopen(FN1, "w+"); - if (fp == NULL) - cannot_create(fn); - } else if (if_exists == sKrename_and_delete || - if_exists == sKnew_version || - if_exists == sKsupersede) { - if (smm == smm_output) - fp = fopen_not_dir(FN1, "w"); - else - fp = fopen_not_dir(FN1, "w+"); - if (fp == NULL) - cannot_create(fn); - } else if (if_exists == sKoverwrite) { - fp = fopen_not_dir(FN1, "r+"); - if (fp == NULL) - cannot_open(fn); - } else if (if_exists == sKappend) { - if (smm == smm_output) - fp = fopen_not_dir(FN1, "a"); - else - fp = fopen_not_dir(FN1, "a+"); - if (fp == NULL) + if (!(fp=fopen(FN1,smm==smm_output ? "w" : "w+"))) cannot_create(fn); + } else if (if_exists==sKrename_and_delete || + if_exists==sKnew_version || + if_exists==sKsupersede) { + if (!(fp=fopen(FN1,smm==smm_output ? "w" : "w+"))) cannot_create(fn); + } else if (if_exists==sKoverwrite) { + if (!(fp=fopen_not_dir(FN1,"r+"))) cannot_open(fn); + } else if (if_exists==sKappend) { + if (!(fp = fopen_not_dir(FN1,smm==smm_output ? "a" : "a+"))) FEerror("Cannot append to the file ~A.",1,fn); - } else if (if_exists == Cnil) - return(Cnil); - else - FEerror("~S is an illegal IF-EXISTS option.", - 1, if_exists); + } else if (if_exists == Cnil) return(Cnil); + else FEerror("~S is an illegal IF-EXISTS option.",1,if_exists); + } else { + if (if_does_not_exist == sKerror) FILE_ERROR(fn,"The file does not exist"); else if (if_does_not_exist == sKcreate) { - if (smm == smm_output) { - if(FN1[0]=='|') - fp = popen(FN1+1,"w"); - else - fp = fopen_not_dir(FN1, "w"); - } else - fp = fopen_not_dir(FN1, "w+"); - if (fp == NULL) + if (!(fp=smm==smm_output ? (*FN1=='|' ? popen(FN1+1,"w") : fopen_not_dir(FN1, "w")) : fopen_not_dir(FN1, "w+"))) cannot_create(fn); - } else if (if_does_not_exist == Cnil) - return(Cnil); - else - FEerror("~S is an illegal IF-DOES-NOT-EXIST option.", - 1, if_does_not_exist); + } else if (if_does_not_exist==Cnil) return(Cnil); + else FEerror("~S is an illegal IF-DOES-NOT-EXIST option.",1,if_does_not_exist); } - } else + break; + + default: FEerror("Illegal open mode for ~S.",1,fn); + break; + } vs_push(make_simple_string(FN1)); x = alloc_object(t_stream); @@ -600,10 +566,6 @@ close_stream(object strm) { fclose(strm->sm.sm_fp); strm->sm.sm_fp = NULL; strm->sm.sm_fd = -1; - if (strm->sm.sm_object0 && - type_of(strm->sm.sm_object0 )==t_cons && - Mcar(strm->sm.sm_object0)==sSAallow_gzipped_fileA) - ifuncall1(sLdelete_file,Mcdr(strm->sm.sm_object0)); break; case smm_file_synonym: @@ -1762,9 +1724,7 @@ LFD(siLoutput_stream_string)() } DEFUN_NEW("FILE-STREAM-P",object,fSfile_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { - RETURN1(type_of(x)==t_stream && - (x->sm.sm_mode==smm_input || x->sm.sm_mode==smm_output || x->sm.sm_mode==smm_io || x->sm.sm_mode==smm_probe) - ? Ct : Cnil); + RETURN1(type_of(x)==t_stream && file_synonym_stream_p(x) ? Ct : Cnil); } DEFUN_NEW("SYNONYM-STREAM-P",object,fSsynonym_stream_p,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { --- gcl-2.6.12.orig/o/unixfsys.c +++ gcl-2.6.12/o/unixfsys.c @@ -19,8 +19,6 @@ Foundation, 675 Mass Ave, Cambridge, MA */ -#include -#include #include #include @@ -32,140 +30,17 @@ Foundation, 675 Mass Ave, Cambridge, MA #include #endif -#ifdef __MINGW32__ -# include +#ifdef __MINGW32__ +# include /* Windows has no symlink, therefore no lstat. Without symlinks lstat is equivalent to stat anyway. */ # define S_ISLNK(a) 0 # define lstat stat -#endif - -#ifdef BSD -#define HAVE_RENAME #endif -#ifdef NEED_GETWD -#include - - -#ifndef HAVE_GETCWD -char dotdot[3*16+2] = "../../../../../../../../../../../../../../../../."; -#include -static char *getwd_buf; -static int getwd_bufp; - -static char * -getwd(buffer) -char *buffer; -{ - getwd_buf = buffer; - getwd1(0); - if (getwd_bufp == 0) - getwd_buf[getwd_bufp++] = '/'; - getwd_buf[getwd_bufp] = '\0'; - return(getwd_buf); -} - -getwd1(n) -int n; -{ - struct stat st, dev_st; - struct direct dir; - ino_t ino; - struct mnttab mnt; - FILE *fp; - register int i; - char buf[BUFSIZ]; - static char dev_name[64]; - - if (stat(dotdot+(16-n)*3, &st) < 0) - FEerror("Can't get the current working directory.", 0); - ino = st.st_ino; - if (ino == 2) - goto ROOT; - getwd1(n+1); - fp = fopen(dotdot+(16-n-1)*3, "r"); - if (fp == NULL) - FEerror("Can't get the current working directory.", 0); - setbuf(fp, buf); - fread(&dir, sizeof(struct direct), 1, fp); - fread(&dir, sizeof(struct direct), 1, fp); - for (;;) { - if (fread(&dir, sizeof(struct direct), 1, fp) <= 0) - break; - if (dir.d_ino == ino) - goto FOUND; - } - fclose(fp); - FEerror("Can't get the current working directory.", 0); - -FOUND: - fclose(fp); - getwd_buf[getwd_bufp++] = '/'; - for (i = 0; i < DIRSIZ && dir.d_name[i] != '\0'; i++) - getwd_buf[getwd_bufp++] = dir.d_name[i]; - return; - -ROOT: - fp = fopen("/etc/mnttab", "r"); - if (fp == NULL) - FEerror("Can't get the current working directory.", 0); - setbuf(fp, buf); - for (;;) { - if (fread(&mnt, sizeof(struct mnttab), 1, fp) <= 0) - break; - if (mnt.mt_dev[0] != '/') { - strcpy(dev_name, "/dev/dsk/"); - strcat(dev_name, mnt.mt_dev); - stat(dev_name, &dev_st); - } else - stat(mnt.mt_dev, &dev_st); - if (dev_st.st_rdev == st.st_dev) - goto DEV_FOUND; - } - fclose(fp); - getwd_bufp = 0; - return; - -DEV_FOUND: - fclose(fp); - getwd_bufp = 0; - for (i = 0; mnt.mt_filsys[i] != '\0'; i++) - getwd_buf[i] = mnt.mt_filsys[i]; - /* BUG FIX by Grant J. Munsey */ - if (i == 1 && *getwd_buf == '/') - i = 0; /* don't add an empty directory name */ - /* END OF BUG FIX */ - getwd_bufp = i; -} -#endif /* not HAVE_GETCWD */ -#endif - -#ifndef MAXPATHLEN -#define MAXPATHLEN 512 -#endif - - -#ifdef HAVE_GETCWD -char * -getwd(char *buffer) { -#ifndef _WIN32 - char *getcwd(char *, size_t); -#endif - return(getcwd(buffer, MAXPATHLEN)); -} -#endif - - -#define pcopy(a_,b_,c_,d_) ({\ - unsigned _c=c_,_d=d_;\ - if (_c+_d>=MAXPATHLEN-16) FEerror("Can't expand pathname ~a",1,namestring);\ - bcopy(a_,b_+_c,_d);\ - b_[_c+_d]=0;\ - }) - static object get_string(object x) { + switch(type_of(x)) { case t_symbol: case t_string: @@ -180,182 +55,110 @@ get_string(object x) { case smm_io: return get_string(x->sm.sm_object1); case smm_file_synonym: - case smm_synonym: return get_string(x->sm.sm_object0->s.s_dbind); } } + return Cnil; -} +} void -coerce_to_filename(object pathname,char *p) { +coerce_to_filename1(object spec, char *p,unsigned sz) { - object namestring=get_string(pathname); - unsigned e=namestring->st.st_fillp; - char *q=namestring->st.st_self,*qe=q+e; + object namestring=get_string(spec); - if (pathname==Cnil||namestring==Cnil) - FEerror ( "NIL argument.", 1, pathname ); - - if (*q=='~' && e) { + massert(namestring->st.st_fillpst.st_self,namestring->st.st_fillp); + p[namestring->st.st_fillp]=0; - unsigned m=0; - char *s=++q,*c; +#ifdef FIX_FILENAME + FIX_FILENAME(spec,p); +#endif - for (;spw_dir,p,0,m=strlen(pwent->pw_dir)); - - } -#endif + massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); + massert(rpw_name)); - pcopy(q,p,0,e); - -#ifdef FIX_FILENAME - FIX_FILENAME(pathname,p); -#endif - } -object sSAallow_gzipped_fileA; +DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { -bool -file_exists(object file) -{ - char filename[MAXPATHLEN]; - struct stat filestatus; + struct passwd *pwent,pw; + long r; - coerce_to_filename(file, filename); + massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); + massert(r filename) && - ( ( *(p-1) == '/' ) || ( *(p-1) == '\\' ) ) ) { - *(p-1) = '\0'; - } - } -#endif - - if (stat(filename, &filestatus) >= 0 && !S_ISDIR(filestatus.st_mode)) - { -#ifdef AIX - /* if /tmp/foo is not a directory /tmp/foo/ should not exist */ - if (filename[strlen(filename)-1] == '/' && - !( filestatus.st_mode & S_IFDIR)) - return(FALSE); -#endif - - return TRUE; - } - else - if (sSAallow_gzipped_fileA->s.s_dbind != sLnil - && (strcat(filename,".gz"), - stat(filename, &filestatus) >= 0 && !S_ISDIR(filestatus.st_mode))) - - return TRUE; + if (nm->st.st_fillp==1) - else - return(FALSE); -} + if ((pw.pw_dir=getenv("HOME"))) + pwent=&pw; + else + massert(!getpwuid_r(getuid(),&pw,FN1,r,&pwent) && pwent); -FILE * -fopen_not_dir(char *filename,char * option) { + else { - struct stat ss; + massert(nm->st.st_fillpst.st_self+1,nm->st.st_fillp-1); + FN2[nm->st.st_fillp-1]=0; - if (!stat(filename,&ss) && S_ISDIR(ss.st_mode)) - return NULL; - else - return fopen(filename,option); + massert(!getpwnam_r(FN2,&pw,FN1,r,&pwent) && pwent); + + } + + massert(strlen(pwent->pw_dir)+2pw_dir,strlen(pwent->pw_dir)); + FN3[strlen(pwent->pw_dir)]='/'; + FN3[strlen(pwent->pw_dir)+1]=0; + RETURN1(make_simple_string(FN3)); } +#define FILE_EXISTS_P(a_,b_) !stat(a_,&b_) && S_ISREG(b_.st_mode) +#define DIR_EXISTS_P(a_,b_) !stat(a_,&b_) && S_ISDIR(b_.st_mode) + FILE * -backup_fopen(char *filename, char *option) -{ - char backupfilename[MAXPATHLEN]; - char command[MAXPATHLEN * 2]; +fopen_not_dir(char *filename,char *option) { + + struct stat ss; + + return DIR_EXISTS_P(filename,ss) ? NULL : fopen(filename,option); - strcat(strcpy(backupfilename, filename), ".BAK"); - sprintf(command, "mv %s %s", filename, backupfilename); - msystem(command); - return(fopen(filename, option)); } int -file_len(FILE *fp) -{ - struct stat filestatus; +file_len(FILE *fp) {/*FIXME dir*/ - if (fstat(fileno(fp), &filestatus)==0) - return(filestatus.st_size); - else return 0; -} + struct stat filestatus; -DEF_ORDINARY("DIRECTORY",sKdirectory,KEYWORD,""); -DEF_ORDINARY("LINK",sKlink,KEYWORD,""); -DEF_ORDINARY("FILE",sKfile,KEYWORD,""); + return fstat(fileno(fp), &filestatus) ? 0 : filestatus.st_size; -/* export these for AXIOM */ -int gcl_putenv(char *s) {return putenv(s);} -char *gcl_strncpy(char *d,const char *s,size_t z) {return strncpy(d,s,z);} -char *gcl_strncpy_chk(size_t z) {char a[10],b[10];return strncpy(a,b,z);}/*compile in __strncpy_chk with FORTIFY_SOURCE*/ -#ifdef __MINGW32__ -#define uid_t int -#endif -uid_t gcl_geteuid(void) { -#ifndef __MINGW32__ - return geteuid(); -#else - return 0; -#endif -} -uid_t gcl_getegid(void) { -#ifndef __MINGW32__ - return getegid(); -#else - return 0; -#endif } -int gcl_dup2(int o,int n) {return dup2(o,n);} -char *gcl_gets(char *s,int z) {return fgets(s,z,stdin);} -int gcl_puts(const char *s) {int i=fputs(s,stdout);fflush(stdout);return i;} +bool +file_exists(object x) { -int gcl_feof(void *v) {return feof(((FILE *)v));} -int gcl_getc(void *v) {return getc(((FILE *)v));} -int gcl_putc(int i,void *v) {return putc(i,((FILE *)v));} + struct stat ss; + + coerce_to_filename(x,FN1); + return FILE_EXISTS_P(FN1,ss) ? TRUE : FALSE; +} + +DEF_ORDINARY("DIRECTORY",sKdirectory,KEYWORD,""); +DEF_ORDINARY("LINK",sKlink,KEYWORD,""); +DEF_ORDINARY("FILE",sKfile,KEYWORD,""); DEFUNM_NEW("STAT",object,fSstat,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { @@ -381,6 +184,31 @@ DEFUNM_NEW("STAT",object,fSstat,SI,1,1,N make_fixnum(ss.st_uid)); } +#include +#include +#include +#include + +DEFUN_NEW("READLINKAT",object,fSreadlinkat,SI,2,2,NONE,OI,OO,OO,OO,(fixnum d,object s),"") { + ssize_t l,z1; + + check_type_string(&s); + /* l=s->st.st_hasfillp ? s->st.st_fillp : s->st.st_dim; */ + z1=length(s); + massert(z1st.st_self,z1); + FN1[z1]=0; + massert((l=readlinkat(d ? dirfd((DIR *)d) : AT_FDCWD,FN1,FN2,sizeof(FN2)))>=0 && l DEFUN_NEW("OPENDIR",object,fSopendir,SI,1,1,NONE,IO,OO,OO,OO,(object x),"") { - DIR *d; - char filename[MAXPATHLEN]; check_type_string(&x); - memcpy(filename,x->st.st_self,x->st.st_fillp); - filename[x->st.st_fillp]=0; - d=opendir(filename); - return (object)d; + coerce_to_filename(x,FN1); + return (object)opendir(FN1); } #ifdef HAVE_D_TYPE @@ -430,19 +254,27 @@ DEFUN_NEW("D-TYPE-LIST",object,fSd_type_ MMcons(make_fixnum(DT_UNKNOWN),make_keyword("UNKNOWN")) )); } +#else +#define DT_UNKNOWN 0 #endif DEFUN_NEW("READDIR",object,fSreaddir,SI,3,3,NONE,OI,IO,OO,OO,(fixnum x,fixnum y,object s),"") { + struct dirent *e; object z; long tl; size_t l; + if (!x) RETURN1(Cnil); + tl=telldir((DIR *)x); -#ifdef HAVE_D_TYPE - for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && e->d_type!=y;); + +#ifndef HAVE_D_TYPE + y=DT_UNKNOWN; #endif + for (;(e=readdir((DIR *)x)) && y!=DT_UNKNOWN && e->d_type!=y;); if (!e) RETURN1(Cnil); + if (s==Cnil) z=make_simple_string(e->d_name); else { @@ -457,10 +289,13 @@ DEFUN_NEW("READDIR",object,fSreaddir,SI, RETURN1(make_fixnum(l)); } } + #ifdef HAVE_D_TYPE if (y==DT_UNKNOWN) z=MMcons(z,make_fixnum(e->d_type)); #endif + RETURN1(z); + } DEFUN_NEW("CLOSEDIR",object,fSclosedir,SI,1,1,NONE,OI,OO,OO,OO,(fixnum x),"") { @@ -468,165 +303,174 @@ DEFUN_NEW("CLOSEDIR",object,fSclosedir,S return Cnil; } -DEFUN_NEW("MKDIR",object,fSmkdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { - - char filename[MAXPATHLEN]; +DEFUN_NEW("RENAME",object,fSrename,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { check_type_string(&x); + check_type_string(&y); - memcpy(filename,x->st.st_self,x->st.st_fillp); - filename[x->st.st_fillp]=0; - -#ifdef __MINGW32__ - if (mkdir(filename) < 0) -#else - if (mkdir(filename,01777) < 0) -#endif - FEerror("Cannot make the directory ~S.", 1, vs_base[0]); + coerce_to_filename(x,FN1); + coerce_to_filename(y,FN2); - RETURN1(x); + RETURN1(rename(FN1,FN2) ? Cnil : Ct); } -DEFUN_NEW("RMDIR",object,fSrmdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { +DEFUN_NEW("UNLINK",object,fSunlink,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + check_type_string(&x); coerce_to_filename(x,FN1); - RETURN1(rmdir(FN1) ? Cnil : Ct); + RETURN1(unlink(FN1) ? Cnil : Ct); } +DEFUN_NEW("CHDIR1",object,fSchdir1,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { -#include -#include -#include -#include + check_type_string(&x); -DEFUN_NEW("READLINKAT",object,fSreadlinkat,SI,2,2,NONE,OI,OO,OO,OO,(fixnum d,object s),"") { - char *b1,*b2=NULL; - ssize_t l,z1,z2; - check_type_string(&s); - /* l=s->st.st_hasfillp ? s->st.st_fillp : s->st.st_dim; */ - z1=length(s); - massert((b1=alloca(z1+1))); - memcpy(b1,s->st.st_self,z1); - b1[z1]=0; - for (l=z2=0;l>=z2;) { - memset(b2,0,z2); - z2+=z2+10; - massert((b2=alloca(z2))); - massert((l=readlinkat(d ? dirfd((DIR *)d) : AT_FDCWD,b1,b2,z2))>=0); - } - b2[l]=0; - s=make_simple_string(b2); - memset(b1,0,z1); - memset(b2,0,z2); - RETURN1(s); -} + coerce_to_filename(x,FN1); -DEFUN_NEW("GETCWD",object,fSgetcwd,SI,0,0,NONE,OO,OO,OO,OO,(void),"") { - char *b=NULL; - size_t z; - object s; - - for (z=0;!(errno=0) && !getcwd(b,z) && errno==ERANGE;b=memset(b,0,z),z+=z+10,({massert((b=alloca(z)));})); - massert((b=getcwd(b,z))); - s=make_simple_string(b); - memset(b,0,z); - RETURN1(s); + RETURN1(chdir(FN1) ? Cnil : Ct); } -DEFUN_NEW("UID-TO-NAME",object,fSuid_to_name,SI,1,1,NONE,OI,OO,OO,OO,(fixnum uid),"") { - struct passwd *pwent,pw; - char *b; - long r; +DEFUN_NEW("MKDIR",object,fSmkdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { - massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); - massert(b=alloca(r)); + check_type_string(&x); - massert(!getpwuid_r(uid,&pw,b,r,&pwent)); + coerce_to_filename(x,FN1); - RETURN1(make_simple_string(pwent->pw_name)); + RETURN1(mkdir(FN1 +#ifndef __MINGW32__ + ,01777 +#endif + ) ? Cnil : Ct); } -DEFUN_NEW("HOME-NAMESTRING",object,fShome_namestring,SI,1,1,NONE,OO,OO,OO,OO,(object nm),"") { +DEFUN_NEW("RMDIR",object,fSrmdir,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { + check_type_string(&x); - struct passwd *pwent,pw; - char *b; - long r; + coerce_to_filename(x,FN1); - massert((r=sysconf(_SC_GETPW_R_SIZE_MAX))>=0); - massert(b=alloca(r)); + RETURN1(rmdir(FN1) ? Cnil : Ct); - if (nm->st.st_fillp==1) +} - if ((pw.pw_dir=getenv("HOME"))) - pwent=&pw; - else - massert(!getpwuid_r(getuid(),&pw,b,r,&pwent)); +DEFVAR("*LOAD-WITH-FREAD*",sSAload_with_freadA,SI,Cnil,""); - else { +#ifdef _WIN32 - char *name; +void * +get_mmap(FILE *fp,void **ve) { - massert(name=alloca(nm->st.st_fillp)); - memcpy(name,nm->st.st_self+1,nm->st.st_fillp-1); - name[nm->st.st_fillp-1]=0; + int n; + void *st; + size_t sz; + HANDLE handle; + + massert((sz=file_len(fp))>0); + if (sSAload_with_freadA->s.s_dbind==Cnil) { + n=fileno(fp); + massert((n=fileno(fp))>2); + massert(handle = CreateFileMapping((HANDLE)_get_osfhandle(n), NULL, PAGE_WRITECOPY, 0, 0, NULL)); + massert(st=MapViewOfFile(handle,FILE_MAP_COPY,0,0,sz)); + CloseHandle(handle); + } else { + massert(st=malloc(sz)); + massert(fread(st,sz,1,fp)==1); + } - massert(!getpwnam_r(name,&pw,b,r,&pwent)); + *ve=st+sz; - } + return st; + +} - massert((b=alloca(strlen(pwent->pw_dir)+2))); - memcpy(b,pwent->pw_dir,strlen(pwent->pw_dir)); - b[strlen(pwent->pw_dir)]='/'; - b[strlen(pwent->pw_dir)+1]=0; - RETURN1(make_simple_string(b)); +int +un_mmap(void *v1,void *ve) { + + if (sSAload_with_freadA->s.s_dbind==Cnil) + return UnmapViewOfFile(v1) ? 0 : -1; + else { + free(v1); + return 0; + } } -DEFUN_NEW("RENAME",object,fSrename,SI,2,2,NONE,OO,OO,OO,OO,(object x,object y),"") { - check_type_string(&x); - check_type_string(&y); +#else - coerce_to_filename(x,FN1); - coerce_to_filename(y,FN2); +#include - RETURN1(rename(FN1,FN2) ? Cnil : Ct); +void * +get_mmap(FILE *fp,void **ve) { + + int n; + void *v1; + struct stat ss; + + massert((n=fileno(fp))>2); + massert(!fstat(n,&ss)); + if (sSAload_with_freadA->s.s_dbind==Cnil) { + massert((v1=mmap(0,ss.st_size,PROT_READ|PROT_WRITE,MAP_PRIVATE,n,0))!=(void *)-1); + } else { + massert(v1=malloc(ss.st_size)); + massert(fread(v1,ss.st_size,1,fp)==1); + } + + *ve=v1+ss.st_size; + return v1; } -DEFUN_NEW("UNLINK",object,fSunlink,SI,1,1,NONE,OO,OO,OO,OO,(object x),"") { - coerce_to_filename(x,FN1); +int +un_mmap(void *v1,void *ve) { - RETURN1(unlink(FN1) ? Cnil : Ct); + if (sSAload_with_freadA->s.s_dbind==Cnil) + return munmap(v1,ve-v1); + else { + free(v1); + return 0; + } } +#endif -static void -FFN(siLchdir)(void) -{ - char filename[MAXPATHLEN]; - - check_arg(1); - check_type_or_pathname_string_symbol_stream(&vs_base[0]); - coerce_to_filename(vs_base[0], filename); - - if (chdir(filename) < 0) - FEerror("Can't change the current directory to ~S.", - 1, vs_base[0]); +/* export these for AXIOM */ +int gcl_putenv(char *s) {return putenv(s);} +char *gcl_strncpy(char *d,const char *s,size_t z) {return strncpy(d,s,z);} +char *gcl_strncpy_chk(size_t z) {char a[10],b[10];return strncpy(a,b,z);}/*compile in __strncpy_chk with FORTIFY_SOURCE*/ +#ifdef __MINGW32__ +#define uid_t int +#endif +uid_t gcl_geteuid(void) { +#ifndef __MINGW32__ + return geteuid(); +#else + return 0; +#endif +} +uid_t gcl_getegid(void) { +#ifndef __MINGW32__ + return getegid(); +#else + return 0; +#endif } +int gcl_dup2(int o,int n) {return dup2(o,n);} +char *gcl_gets(char *s,int z) {return fgets(s,z,stdin);} +int gcl_puts(const char *s) {int i=fputs(s,stdout);fflush(stdout);return i;} + +int gcl_feof(void *v) {return feof(((FILE *)v));} +int gcl_getc(void *v) {return getc(((FILE *)v));} +int gcl_putc(int i,void *v) {return putc(i,((FILE *)v));} void gcl_init_unixfsys(void) { - - make_si_function("CHDIR", siLchdir); - } --- gcl-2.6.12.orig/o/unixsys.c +++ gcl-2.6.12/o/unixsys.c @@ -235,89 +235,6 @@ DEFUN_NEW("GETPID",object,fSgetpid,SI,0, } -DEFVAR("*LOAD-WITH-FREAD*",sSAload_with_freadA,SI,Cnil,""); - -#ifdef _WIN32 - -void * -get_mmap(FILE *fp,void **ve) { - - int n; - void *st; - size_t sz; - HANDLE handle; - - massert((sz=file_len(fp))>0); - if (sSAload_with_freadA->s.s_dbind==Cnil) { - n=fileno(fp); - massert((n=fileno(fp))>2); - massert(handle = CreateFileMapping((HANDLE)_get_osfhandle(n), NULL, PAGE_WRITECOPY, 0, 0, NULL)); - massert(st=MapViewOfFile(handle,FILE_MAP_COPY,0,0,sz)); - CloseHandle(handle); - } else { - massert(st=malloc(sz)); - massert(fread(st,sz,1,fp)==1); - } - - *ve=st+sz; - - return st; - -} - -int -un_mmap(void *v1,void *ve) { - - if (sSAload_with_freadA->s.s_dbind==Cnil) - return UnmapViewOfFile(v1) ? 0 : -1; - else { - free(v1); - return 0; - } - -} - - -#else - -#include - -void * -get_mmap(FILE *fp,void **ve) { - - int n; - void *v1; - struct stat ss; - - massert((n=fileno(fp))>2); - massert(!fstat(n,&ss)); - if (sSAload_with_freadA->s.s_dbind==Cnil) { - massert((v1=mmap(0,ss.st_size,PROT_READ|PROT_WRITE,MAP_PRIVATE,n,0))!=(void *)-1); - } else { - massert(v1=malloc(ss.st_size)); - massert(fread(v1,ss.st_size,1,fp)==1); - } - - *ve=v1+ss.st_size; - return v1; - -} - - -int -un_mmap(void *v1,void *ve) { - - if (sSAload_with_freadA->s.s_dbind==Cnil) - return munmap(v1,ve-v1); - else { - free(v1); - return 0; - } - -} - -#endif - void gcl_init_unixsys(void) {