Project

General

Profile

1
/*
2
This source file is part of Scol
3
For the latest info, see http://www.scolring.org
4

    
5
Copyright (c) 2010 Stephane Bisaro, aka Iri <iri@irizone.net>
6

    
7
This program is free software; you can redistribute it and/or modify it under
8
the terms of the GNU Lesser General Public License as published by the Free Software
9
Foundation; either version 2 of the License, or (at your option) any later
10
version.
11

    
12
This program is distributed in the hope that it will be useful, but WITHOUT
13
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
14
FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details.
15

    
16
You should have received a copy of the GNU Lesser General Public License along with
17
this program; if not, write to the Free Software Foundation, Inc., 59 Temple
18
Place - Suite 330, Boston, MA 02111-1307, USA, or go to
19
http://www.gnu.org/copyleft/lesser.txt
20

    
21
For others informations, please contact us from http://www.scolring.org/
22
*/
23

    
24
#include "../include/scol_gbase.h"
25

    
26
#if ((defined _WIN32) || (defined __WIN32__))
27
cbmachine ww;
28
#endif
29
mmachine  mm;
30

    
31

    
32
/**
33
 * \brief _gbaseUserName : Returns the user (or real) name
34
 *
35
 * fun [] S
36
 *
37
 * \param : nothing
38
 * \return S : this name
39
 */
40
int SCOL_gbaseUserName (mmachine m)
41
{
42
    const gchar * name;
43

    
44
    name = g_get_user_name ();
45
    if (name == NULL)
46
        name = g_get_real_name ();
47

    
48
    if (name == NULL)
49
    {
50
        Mpushstrbloc (m, "unknown");
51
        return 0;
52
    }
53
    Mpushstrbloc (m, (char *) name);
54
    return 0;
55
}
56

    
57
/**
58
 * \brief _gBaseHostName : Returns the host name
59
 *
60
 * fun [] S
61
 *
62
 * \param : nothing
63
 * \return S : this name
64
 */
65
int SCOL_gBaseHostName (mmachine m)
66
{
67
    const gchar * name;
68

    
69
    name = g_get_host_name ();
70
    if (name == NULL)
71
    {
72
        Mpushstrbloc (m, "unknown");
73
        return 0;
74
    }
75
    Mpushstrbloc (m, (char *) name);
76
    return 0;
77
}
78

    
79
/**
80
 * \brief _gBaseDirCur : Returns the current directory (by default on MS Windows "C:\Program Files\Scol Voyager")
81
 *
82
 * fun [] S
83
 *
84
 * \param : nothing
85
 * \return S : this directory
86
 */
87
int SCOL_gBaseDirCur (mmachine m)
88
{
89
    const gchar * name;
90

    
91
    name = g_get_current_dir ();
92
    if (name == NULL)
93
    {
94
        Mpushstrbloc (m, "unknown");
95
        return 0;
96
    }
97
    Mpushstrbloc (m, (char *) name);
98
    return 0;
99
}
100

    
101
/**
102
 * \brief _gBasePathAbsolute : Returns 1 if the given file_name is an absolute file name.
103
 *
104
 * fun [S] I
105
 *
106
 * \param S : any path
107
 * \return I : 1 if TRUE,otherwise 0
108
 */
109
 int SCOL_gBasePathAbsolute (mmachine m)
110
 {
111
    int mpath;
112
    gboolean value;
113

    
114
    mpath = MMpull (m);
115
    if (mpath == NIL)
116
    {
117
        MMpush (m, NIL);
118
        return 0;
119
    }
120

    
121
    value = g_path_is_absolute (MMstartstr (m, MTOP (mpath)));
122
    MMpush (m, ITOM (value));
123
    return 0;
124
 }
125

    
126
/**
127
 * \brief _gBasePathBase : Returns the last component of the filename
128
 *
129
 * fun [S] S
130
 *
131
 * \param S : any path
132
 * \return S : this last component
133
 */
134
int SCOL_gBasePathBase (mmachine m)
135
{
136
    int mpath;
137
    gchar *base;
138

    
139
    mpath = MMpull (m);
140
    if (mpath == NIL)
141
    {
142
        MMpush (m, NIL);
143
        return 0;
144
    }
145
    base = g_path_get_basename (MMstartstr (m, MTOP (mpath)));
146
    Mpushstrbloc (m, base);
147
    g_free (base);
148
    return 0;
149
}
150

    
151
/**
152
 * \brief _gBasePathDir : Returns the directory components of a file name.
153
 *
154
 * fun [S] S
155
 *
156
 * \param S : any path
157
 * \return S : this directory
158
 */
159
int SCOL_gBasePathDir (mmachine m)
160
{
161
    int mpath;
162
    gchar *dir;
163

    
164
    mpath = MMpull (m);
165
    if (mpath == NIL)
166
    {
167
        MMpush (m, NIL);
168
        return 0;
169
    }
170
    dir = g_path_get_dirname (MMstartstr (m, MTOP (mpath)));
171
    Mpushstrbloc (m, dir);
172
    g_free (dir);
173
    return 0;
174
}
175

    
176
/**
177
 * \brief _gBasePathBuild : Creates a filename from a list of elements using the correct separator for filenames.
178
 *
179
 * fun [[S r1] I] S
180
 *
181
 * \param [S r1] : a list of elements (typically, a list of directory : a :: b :: c :: file.ext)
182
 * \param I : 1 : OS separator, otherwise Scol separator (/)
183
 * \return S : the filename
184
 */
185
int SCOL_gBasePathBuild (mmachine m)
186
{
187
    int mlist, mflag;
188
    int size = 0, i = 0;
189
    gchar **list;
190
    gchar *fn;
191

    
192
    mflag = MTOI (MMpull (m));
193
    mlist = MMget (m, 0);
194
    if (mlist == NIL)
195
    {
196
        MMpush (m, NIL);
197
        return 0;
198
    }
199
    mlist = MTOP (mlist);
200

    
201
    while (mlist != NIL)
202
    {
203
        size++;
204
        mlist = MMfetch (m, mlist, 1)>>1;
205
    }
206

    
207
    list = g_new0 (gchar*, size + 2);
208
    mlist = MTOP (MMpull (m));
209
    for (; i < size; i++)
210
    {
211
        list[i] = MMstartstr (m, MTOP (MMfetch (m, mlist, 0)));
212
        mlist = MTOP (MMfetch (m, mlist, 1));
213
    }
214

    
215
    if (mflag == 1)
216
        fn = g_build_filenamev (list);
217
    else
218
        fn = g_build_pathv ("/", list);
219
    Mpushstrbloc (m, fn);
220
    g_free (list);
221
    g_free (fn);
222
    return 0;
223
}
224

    
225
/**
226
 * \brief _gBaseStringUTF8 : Converts a string in the current locale into a UTF-8 string or reverse.
227
 *
228
 * fun [S I] S
229
 *
230
 * \param S : any string
231
 * \param I : 1 to UTF8, 0 to current locale
232
 * \return : the new string
233
 */
234
int SCOL_gBaseStringUTF8 (mmachine m)
235
{
236
    int mstring, mflag;
237
    gchar *string;
238

    
239
    mflag = MMpull (m);
240
    mstring = MMpull (m);
241

    
242
    if (mstring == NIL)
243
    {
244
        MMpush (m, NIL);
245
        return 0;
246
    }
247
    if (mflag)
248
        string = SCOLUTF8 (MMstartstr (m, MTOP (mstring)), -1);
249
    else
250
        string = UTF8SCOL (MMstartstr (m, MTOP (mstring)), -1);
251
    Mpushstrbloc (m, string);
252
    g_free (string);
253
    return 0;
254
}
255

    
256
/**
257
 * \brief _gbaseChecksumS : Computes the checksum of a string.
258
 *
259
 * fun [S I] S
260
 *
261
 * \param S : any string
262
 * \param I : the hashing algorithm to use : 0 -> MD5 (default), 1 -> SHA-1, 2 -> SHA-256
263
 * \return S : the checksum as an hexadecimal string.
264
 */
265
int SCOL_gbaseChecksumS (mmachine m)
266
{
267
    int mstring, mtype;
268
    GChecksumType type = G_CHECKSUM_MD5;
269
    gchar *string;
270

    
271
    mtype = MTOI (MMpull (m));
272
    mstring = MMpull (m);
273

    
274
    if (mstring == NIL)
275
    {
276
        MMpush (m, NIL);
277
        return 0;
278
    }
279
    mstring = MTOP (mstring);
280

    
281
    if (mtype == 1)
282
        type = G_CHECKSUM_SHA1;
283
    else if (mtype == 2)
284
        type = G_CHECKSUM_SHA256;
285

    
286
    string = g_compute_checksum_for_string (type, MMstartstr (m, mstring), -1);
287
    Mpushstrbloc (m, string);
288
    g_free (string);
289
    return 0;
290
}
291

    
292
/**
293
 * \brief _gbaseChecksumP : Computes the checksum of a file.
294
 *
295
 * fun [P I] S
296
 *
297
 * \param S : any file (read referenced only)
298
 * \param I : the hashing algorithm to use : 0 -> MD5 (default), 1 -> SHA-1, 2 -> SHA-256
299
 * \return S : the checksum as an hexadecimal string.
300
 */
301
int SCOL_gbaseChecksumP (mmachine m)
302
{
303
    /* #define SCSP_MAX_SIZE G_MAXUINT-1 */ /* i'm stupid ! */
304
    #define SCSP_MAX_SIZE 1024*32   /* 32 ko / each loop */
305
    int mfile, mtype;
306
    guchar data[SCSP_MAX_SIZE];
307
    gsize size = 0;
308
    GChecksumType type = G_CHECKSUM_MD5;
309
    GChecksum *cs;
310
    const gchar *string;
311
    FILE *file;
312

    
313
    mtype = MTOI (MMpull (m));
314
    mfile = MMpull (m);
315

    
316
    if (mfile == NIL)
317
    {
318
        MMpush (m, NIL);
319
        return 0;
320
    }
321
    mfile = MTOP (mfile);
322

    
323
    file = fopen (MMstartstr (m, mfile), "rb");
324
    if (file == NULL)
325
    {
326
        MMpush (m, NIL);
327
        return 0;
328
    }
329

    
330
    if (mtype == 1)
331
        type = G_CHECKSUM_SHA1;
332
    else if (mtype == 2)
333
        type = G_CHECKSUM_SHA256;
334

    
335
    cs = g_checksum_new (type);
336
    do
337
    {
338
        size = fread((void *) data, sizeof (guchar), SCSP_MAX_SIZE, file);
339
        g_checksum_update (cs, data, size);
340
    }
341
    while (size == SCSP_MAX_SIZE);
342
    fclose (file);
343

    
344
    string = g_checksum_get_string (cs);
345
    Mpushstrbloc (m, (char *) string);
346
    g_checksum_free (cs);
347
    return 0;
348
}
349

    
350
/**
351
 * \brief _gbaseSleep : Pauses the current thread for the given number of milliseconds.
352
 *
353
 * fun [I] I
354
 *
355
 * \param I : the number of milliseconds
356
 * \return I : 0 if success, nil if error
357
 */
358
int SCOL_gbaseSleep (mmachine m)
359
{
360
    int msleep;
361

    
362
    msleep = MTOI (MMpull (m));
363
    if (msleep <= 0)
364
    {
365
        MMpush (m, NIL);
366
        return 0;
367
    }
368

    
369
    g_usleep (1000*msleep);
370
    MMpush (m, ITOM (0));
371
    return 0;
372
}
373

    
374
/**
375
 * \brief _gbaseFileStat : it should not be used, at this time
376
 *
377
 * fun [P] [I I I I]
378
 *
379
 * \param P : a filename (read reference only)
380
 * \return [I I I I] : size, last access, last modification, last state changed
381
 */
382
int SCOL_gbaseFileStat (mmachine m)
383
{
384
    int mfile;
385
    int result;
386
    GStatBuf *s = NULL;
387

    
388
    mfile = MMpull(m);
389
    if (mfile == NIL)
390
    {
391
        MMpush (m, NIL);
392
        return 0;
393
    }
394
    mfile = MTOP (mfile);
395

    
396
    result = g_stat (MMstartstr (m, mfile), s);
397
    if (result != 0)
398
    {
399
        MMpush (m, NIL);
400
        return 0;
401
    }
402
    MMpush (m, ITOM (s->st_size));
403
    MMpush (m, ITOM (s->st_atime));
404
    MMpush (m, ITOM (s->st_mtime));
405
    MMpush (m, ITOM (s->st_ctime));
406
    MMpush (m, ITOM (4));
407
    MBdeftab (m);
408

    
409
    return 0;
410
}
411

    
412
/**
413
 * \brief _gbaseIsIp : Tests if a string is a form of an IPv4 or IPv6 address (like "123.210.012.231").
414
 * fun [S] I
415
 * \param S : any string
416
 * \return I : 1 if TRUE, 0 if FALSE
417
 */
418
int SCOL_gbaseIsIp (mmachine m)
419
{
420
    int ms;
421

    
422
    ms = MMpull (m);
423
    if (ms == NIL)
424
    {
425
        MMpush (m, NIL);
426
        return 0;
427
    }
428
    MMpush (m, ITOM (g_hostname_is_ip_address (MMstartstr (m, MTOP (ms)))));
429
    return 0;
430
}
431

    
432

    
433

    
434

    
435

    
436

    
437
/* API d?finitions : */
438

    
439
char* gbase_name[GBASE_PKG_NB]=
440
{
441
    "_gbaseUserName",
442
    "_gBaseHostName",
443
    "_gBaseDirCur",
444
    "_gBasePathAbsolute",
445
    "_gBasePathBase",
446
    "_gBasePathDir",
447
    "_gBasePathBuild",
448
    "_gBaseStringUTF8",
449
    "_gbaseChecksumS",
450
    "_gbaseChecksumP",
451
    "_gbaseSleep",
452
    "_gbaseFileStat",
453
    "_gbaseIsIp"
454
};
455

    
456
int (*gbase_fun[GBASE_PKG_NB])(mmachine m)=
457
{
458
    SCOL_gbaseUserName,
459
    SCOL_gBaseHostName,
460
    SCOL_gBaseDirCur,
461
    SCOL_gBasePathAbsolute,
462
    SCOL_gBasePathBase,
463
    SCOL_gBasePathDir,
464
    SCOL_gBasePathBuild,
465
    SCOL_gBaseStringUTF8,
466
    SCOL_gbaseChecksumS,
467
    SCOL_gbaseChecksumP,
468
    SCOL_gbaseSleep,
469
    SCOL_gbaseFileStat,
470
    SCOL_gbaseIsIp
471
};
472

    
473
int gbase_narg[GBASE_PKG_NB]=
474
{
475
    0,      /* SCOL_gbaseUserName */
476
    0,      /* SCOL_gBaseHostName */
477
    0,      /* SCOL_gBaseDirCur */
478
    1,      /* SCOL_gBasePathAbsolute */
479
    1,      /* SCOL_gBasePathBase */
480
    1,      /* SCOL_gBasePathDir */
481
    2,      /* SCOL_gBasePathBuild */
482
    2,       /* SCOL_gBaseStringUTF8 */
483
    2,       /* SCOL_gbaseChecksumS */
484
    2,       /* SCOL_gbaseChecksumP */
485
    1,       /* SCOL_gbaseSleep */
486
    1,       /* SCOL_gbaseFileStat */
487
    1       /* SCOL_gbaseIsIp */
488
};
489

    
490
char* gbase_type[GBASE_PKG_NB]=
491
{
492
    "fun [] S",                     /* SCOL_gbaseUserName */
493
    "fun [] S",                     /* SCOL_gBaseHostName */
494
    "fun [] S",                     /* SCOL_gBaseDirCur */
495
    "fun [S] I",                    /* SCOL_gBasePathAbsolute */
496
    "fun [S] S",                    /* SCOL_gBasePathBase */
497
    "fun [S] S",                    /* SCOL_gBasePathDir */
498
    "fun [[S r1] I] S",             /* SCOL_gBasePathBuild */
499
    "fun [S I] S",                  /* SCOL_gBaseStringUTF8 */
500
    "fun [S I] S",                  /* SCOL_gbaseChecksumS */
501
    "fun [P I] S",                  /* SCOL_gbaseChecksumS */
502
    "fun [I] I",                    /* SCOL_gbaseSleep */
503
    "fun [P] [I I I I]",            /* SCOL_gbaseFileStat */
504
    "fun [S] I"                    /* SCOL_gbaseIsIp */
505
};
506

    
507
int SCOLinitGbaseClass (mmachine m)
508
{
509
    int k;
510

    
511
    MMechostr (0, "SCOLinitGbaseClass : entering\n");
512

    
513
    k = PKhardpak (m, "GBaseEngine", GBASE_PKG_NB, gbase_name, gbase_fun, gbase_narg, gbase_type);
514
    return k;
515
}
516

    
517

    
518
/**
519
 * \brief Load and free the regular expression library
520
 * Plateforms supported : MS Windows and GNU / Linux
521
 */
522

    
523
int GBaseRelease ()
524
{
525
    MMechostr (0, "\nGBASE library released !\n");
526
    return 0;
527
}
528

    
529
#if ((defined _WIN32) || (defined __WIN32__))
530

    
531
__declspec (dllexport) int SCOLloadGBASE (mmachine m, cbmachine w)
532
{
533
    int k = 0;
534
    ww = w;
535
    mm = m;
536

    
537
    MMechostr (MSKDEBUG, "\nGBASE library loading .... !\n");
538
    SCOLinitplugin (w);
539
    if ((k = SCOLinitGbaseClass (m))) return k;
540
    MMechostr(MSKDEBUG, "\nGBASE library loaded !\n");
541
    return k;
542
}
543

    
544
__declspec (dllexport) int SCOLfreeGBASE ()
545
{
546
    GBaseRelease ();
547
    return 0;
548
}
549

    
550

    
551

    
552

    
553

    
554
/* Version GNU / Linux */
555
#elif ((defined linux) || (defined __linux))
556

    
557
int SCOLloadGBASE (mmachine m)
558
{
559
    int k = 0;
560
    mm = m;
561

    
562
    MMechostr (MSKDEBUG, "\nGBASE library loading !\n");
563
    if ((k = SCOLinitGbaseClass (m))) return k;
564
    MMechostr (MSKDEBUG, "\nGBASE library loaded !\n");
565

    
566
    return k;
567
}
568

    
569
int SCOLfreeGBASE ()
570
{
571
    GBaseRelease ();
572
    return 0;
573
}
574

    
575
#else
576
#error no platform supported
577
#endif
578

    
(1-1/4)