rts/dyn-wrapper.c

   1 /* This is the wrapper for dynamically linked executables
   2  *
   3  * Have mercy with this creature born in cross-platform wasteland.
   4  */
   5
   6 #include <sys/types.h>
   7 #include <unistd.h>
   8 #include <sys/stat.h>
   9 #include <fcntl.h>
  10 #include <stdio.h>
  11 #include <string.h>
  12 #include <stdlib.h>
  13 #include <ghcplatform.h>
  14 #include <shell-tools.c>
  15
  16 /* All defining behavior string */
  17 char behaviour[]=BEHAVIOUR;
  18
  19 #define REAL_EXT ".dyn"
  20 #define REAL_EXT_S (sizeof(REAL_EXT)-1)
  21
  22 void *smalloc(size_t size);
  23
  24 #if defined(mingw32_HOST_OS)
  25 #include <wtypes.h>
  26 #include <winbase.h>
  27
  28 #define ENV_NAME "PATH"
  29 #define ENV_SEP ';'
  30 #define EXEEXT ".exe"
  31
  32 #define SET_ENV(n,v) SetEnvironmentVariable(n,v)
  33 #define GET_ENV(n) getEnvWrapper(n)
  34 #define FREE_GET_ENV(x) free(x)
  35
  36 #define DIR_SEP '\\'
  37
  38 char *getEnvWrapper(const char *name) {
  39     int len=GetEnvironmentVariableA(name,NULL,0);
  40     char *value;
  41     if(!len) return NULL;
  42
  43     value=smalloc(len);
  44     GetEnvironmentVariableA(name,value,len);
  45     return value;
  46 }
  47
  48 #define CONVERT_PATH(x) replace(x,'/','\\')
  49
  50
  51 #elif defined(linux_HOST_OS)
  52 #define ENV_NAME "LD_LIBRARY_PATH"
  53 #define ENV_SEP ':'
  54
  55 #define EXEEXT ""
  56 #define SET_ENV(n,v) setenv(n,v,1)
  57 #define GET_ENV(n) getenv(n)
  58
  59 #define FREE_GET_ENV(x)
  60 #define CONVERT_PATH(x)
  61 #define DIR_SEP '/'
  62
  63 #elif defined(darwin_HOST_OS)
  64 #define ENV_NAME "DYLD_LIBRARY_PATH"
  65 #define ENV_SEP ':'
  66
  67 #define EXEEXT ""
  68 #define SET_ENV(n,v) setenv(n,v,1)
  69 #define GET_ENV(n) getenv(n)
  70 #define FREE_GET_ENV(x)
  71
  72 #define CONVERT_PATH(x)
  73 #define DIR_SEP '/'
  74 #else
  75 #error no OS interface defined
  76 #endif
  77
  78 #define EXEEXT_S (sizeof(EXEEXT)-1)
  79
  80 /* Utility functions */
  81
  82 /* Like strtok_r but omitting the first arg and allowing only one delimiter */
  83 char *stringTokenizer (char **this, const char delim)
  84 {
  85     char *oldthis=*this;
  86     char *matched;
  87     if(!this || !(*this)) return NULL;
  88
  89     matched=strchr(*this, delim);
  90     if(matched) {
  91         *matched=0;
  92         *this=matched+1;
  93         return oldthis;
  94     } else {
  95         *this=NULL;
  96         return oldthis;
  97     }
  98 }
  99
 100 /* Replaces all occourances of character 'from' with 'to' in 'x' */
 101 void replace(char *x, char from, char to) {
 102     while(*x) {
 103         if(*x == from)
 104             *x=to;
 105         x++;
 106     }
 107 }
 108
 109 /* Non-failing malloc -- will die on failure */
 110 void *smalloc(size_t size)
 111 {
 112     void *ret=malloc(size);
 113     if(!ret) {
 114         fprintf(stderr,"Can not allocate %d bytes",size);
 115         perror("");
 116         exit(-1);
 117     }
 118     return ret;
 119 }
 120
 121 /* String Cons (scons) -- basically a linked list */
 122 struct scons {
 123     char *value;
 124     struct scons *next;
 125 };
 126
 127 /* Free up a linked list */
 128 void freescons(struct scons *root) {
 129     while(root) {
 130         struct scons *c=root;
 131         root=root->next;
 132         free(c->value);
 133         free(c);
 134     }
 135 }
 136
 137 /* Removes duplicates among the string cons */
 138 struct scons *unique(struct scons *in) {
 139     struct scons *ret=NULL;
 140     struct scons *ci;
 141     for(ci=in; ci!=NULL; ci=ci->next) {
 142         struct scons *cj;
 143         struct scons *nextscons;
 144         for(cj = ret; cj != NULL; cj=cj->next) {
 145             if(!strcmp(ci->value,cj->value))
 146                 break;
 147         }
 148         if(cj!=NULL) continue;
 149
 150         nextscons=smalloc(sizeof(struct scons));
 151         nextscons->next=ret;
 152         nextscons->value=strdup(ci->value);
 153         ret=nextscons;
 154     }
 155     return ret;
 156 }
 157
 158 /* Tries to get a single line from the input stream really _inefficently_ */
 159 char *afgets(FILE *input) {
 160         int bufsize=0;
 161         char *buf=(char *)malloc(bufsize);
 162         do {
 163             bufsize+=1;
 164             buf=realloc(buf,bufsize);
 165         } while(fread(buf+bufsize-1,1,1,input)==1 && buf[bufsize-1]!='\n');
 166         buf[bufsize-1]=0;
 167         return buf;
 168 }
 169
 170 /* Computes the real binaries' name from argv0 */
 171 char *real_binary_name(char *argv0) {
 172     int arg0len=strlen(argv0);
 173     char *alterego;
 174
 175     alterego=strdup(argv0);
 176     if(!strcmp(alterego+arg0len-EXEEXT_S,EXEEXT)) {
 177         alterego[arg0len-EXEEXT_S]=0;
 178         arg0len-=EXEEXT_S;
 179     }
 180     alterego=realloc(alterego,arg0len+REAL_EXT_S+EXEEXT_S+1);
 181     sprintf(alterego+arg0len,"%s%s",REAL_EXT,EXEEXT);
 182     return alterego;
 183 }
 184
 185 /* Gets a field for a GHC package
 186  * This method can't deal with multiline fields
 187  */
 188 #warning FIXME - getGhcPkgField can not deal with multline fields
 189
 190 char *getGhcPkgField(char *ghcpkg, char *package, char *field) {
 191         char *command;
 192         char *line;
 193         FILE *input;
 194         int fieldLn=strlen(field);
 195
 196         /* Format ghc-pkg command */
 197         command=smalloc(strlen(ghcpkg)+strlen(package)+fieldLn+9);
 198         sprintf(command,"%s field %s %s",ghcpkg,package,field);
 199
 200         /* Run */
 201         input=popen(command,"r");
 202
 203         if(!input) {
 204             fprintf(stderr,"Failed to invoke %s", command);
 205             perror("");
 206             free(command);
 207             exit(-1);
 208         }
 209
 210         line=afgets(input);
 211
 212         pclose(input);
 213
 214         free(command);
 215
 216         /* Check for validity */
 217         if(strncmp(line,field,fieldLn)) {
 218             /* Failed */
 219             free(line);
 220             return NULL;
 221         }
 222
 223         /* Cut off "<field>: " in the output and return */
 224         strcpy(line,line+fieldLn+2);
 225         return line;
 226 }
 227
 228 /* Prepends a prefix to an environment variable.
 229    If it is set already, it puts a separator in between */
 230
 231 void prependenv(char *name, char *prefix, char sep)
 232 {
 233     char *orig=GET_ENV(name);
 234     if(orig) {
 235         char *new;
 236         int prefixlength=strlen(prefix);
 237
 238         new=(char *)smalloc(strlen(orig)+prefixlength+2);
 239
 240         strcpy(new,prefix);
 241         new[prefixlength]=sep;
 242         strcpy(new+prefixlength+1,orig);
 243
 244         SET_ENV(name,new);
 245         free(new);
 246     } else {
 247         SET_ENV(name,prefix);
 248     }
 249     FREE_GET_ENV(orig);
 250 }
 251
 252 /* This function probes the library-dirs of all package dependencies,
 253    removes duplicates and adds it to the environment ENV_NAME */
 254 void withghcpkg(char *ghcpkg, char *packages)
 255 {
 256     struct scons *rootlist=NULL;
 257     struct scons *uniqueRootlist=NULL;
 258     struct scons *c;
 259
 260     /* Save pointers for strtok */
 261     char *packageParse;
 262     char *libParse;
 263
 264     char *curpack;
 265
 266     while(curpack=stringTokenizer(&packages,';')) {
 267 #warning We should query for a dynamic-library field not library-dirs.
 268         char *line=getGhcPkgField(ghcpkg, curpack,"library-dirs");
 269         char *line_p=line;  /* need to retain original line for freeing */
 270         char *curlib;
 271
 272         if(!line) {
 273             fprintf(stderr,"Can not query ghc-pkg for fields of packages %s",curpack);
 274             perror("");
 275             exit(-1);
 276         }
 277
 278         while(curlib=stringTokenizer(&line_p,' ')) {
 279             c=smalloc(sizeof(struct scons));
 280             c->next=rootlist;
 281             c->value=strdup(curlib);
 282             rootlist=c;
 283         }
 284         free(line);
 285     }
 286     uniqueRootlist=unique(rootlist);
 287     for(c = uniqueRootlist; c != NULL; c=c->next) {
 288         CONVERT_PATH(c->value);
 289         prependenv(ENV_NAME,c->value,ENV_SEP);
 290     }
 291     freescons(rootlist);
 292     freescons(uniqueRootlist);
 293 }
 294
 295 void add_to(char **base, int *base_size, char **target, const char *src, int src_size) {
 296     if((*target)-(*base)+src_size > *base_size) {
 297         *base=realloc(*base,*base_size+src_size);
 298         *base_size=*base_size+src_size;
 299     }
 300     memcpy(*target,src,src_size);
 301     *target=*target+src_size;
 302 }
 303
 304 /* Scans str and constructs */
 305 char *expandFlexiblePath(char *str)
 306 {
 307     int buffersize=strlen(str)+1;
 308     char *base=smalloc(buffersize);
 309     char *current=base;
 310
 311     while(*str && *str!=';') {
 312         if(*str=='$' && *(str+1)=='{') {
 313             char *start;
 314             char *envcont;
 315             str+=2;
 316             start=str;
 317
 318             while(*str && *str != '}') {
 319                 str++;
 320             }
 321
 322             if(!str) {
 323                 fprintf(stderr,"End of string while scanning environment variable. Wrapper broken\n");
 324                 exit(-1);
 325             }
 326             *str='\0';
 327             str++;
 328             envcont=GET_ENV(start);
 329             if(!envcont) {
 330                 fprintf(stderr,"Referenced environment variable %s not set.",start);
 331                 exit(-1);
 332             }
 333
 334             add_to(&base,&buffersize,&current,envcont,strlen(envcont));
 335             FREE_GET_ENV(envcont);
 336         } else {
 337             add_to(&base,&buffersize,&current,str,1);
 338             str++;
 339         }
 340     }
 341     return base;
 342 }
 343
 344 char *getBasename(const char *path) {
 345     int i;
 346     char *ret;
 347     for(i=strlen(path); i>=0; i--) {
 348         if(path[i]==DIR_SEP) break;
 349     }
 350     ret=smalloc(i+1);
 351     strncpy(ret,path,i);
 352 }
 353
 354 char *agetcwd() {
 355     char *cwd;
 356     int size=100;
 357     cwd=malloc(size);
 358     while(!getcwd(cwd,size)) {
 359         size+=100;
 360         cwd=realloc(cwd,size);
 361     }
 362     return cwd;
 363 }
 364
 365 int main(int argc, char **argv) {
 366     char *alterego;
 367     int arg0len=strlen(argv[0]);
 368     switch(behaviour[0]) {
 369     case 'H': /* hard paths */
 370         replace(behaviour+1,';',ENV_SEP);
 371         CONVERT_PATH(behaviour+1);
 372         prependenv(ENV_NAME,behaviour+1,ENV_SEP);
 373         break;
 374     case 'F':
 375         { /* flexible paths based on ghc-pkg in $GHC_PKG */
 376             char *expanded;
 377             char *arg0base=getBasename(argv[0]);
 378             char *ghc_pkg=behaviour+1;
 379             char *packages;
 380             char *oldwd=agetcwd();
 381
 382             packages=strchr(behaviour+1,';');
 383             *packages=0;
 384             packages++;
 385             expanded=expandFlexiblePath(ghc_pkg);
 386
 387 #warning Will this also change drive on windows? WINDOWS IS SO BROKEN.
 388             chdir(arg0base);
 389
 390             withghcpkg(expanded,packages);
 391             chdir(oldwd);
 392             free(oldwd);
 393             free(expanded);
 394         }
 395         break;
 396     default:
 397         printf("unset wrapper called\n");
 398         exit(-1);
 399     }
 400     alterego=real_binary_name(argv[0]);
 401     return run(argv[0],alterego,argc,argv);
 402 }