libguile/regex-posix.c

   1 /*      Copyright (C) 1997, 1998, 1999, 2000, 2001, 2004, 2006, 2007, 2010, 2011, 2012 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public License
   5  * as published by the Free Software Foundation; either version 3 of
   6  * the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful, but
   9  * WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  16  * 02110-1301 USA
  17  */
  18
  19
  20 \f
  21
  22 /* regex-posix.c -- POSIX regular expression support.
  23
  24    This code was written against Henry Spencer's famous regex package.
  25    The principal reference for POSIX behavior was the man page for this
  26    library, not the 1003.2 document itself.  Ergo, other `POSIX'
  27    libraries which do not agree with the Spencer implementation may
  28    produce varying behavior.  Sigh. */
  29
  30 #ifdef HAVE_CONFIG_H
  31 #  include <config.h>
  32 #endif
  33
  34 #include <sys/types.h>
  35
  36 #include "libguile/_scm.h"
  37
  38 #include <regex.h>
  39
  40 #ifdef HAVE_WCHAR_H
  41 #include <wchar.h>
  42 #endif
  43
  44 #include "libguile/async.h"
  45 #include "libguile/smob.h"
  46 #include "libguile/symbols.h"
  47 #include "libguile/vectors.h"
  48 #include "libguile/strports.h"
  49 #include "libguile/ports.h"
  50 #include "libguile/feature.h"
  51 #include "libguile/strings.h"
  52
  53 #include "libguile/validate.h"
  54 #include "libguile/regex-posix.h"
  55
  56 /* This is defined by some regex libraries and omitted by others. */
  57 #ifndef REG_BASIC
  58 #define REG_BASIC 0
  59 #endif
  60
  61 scm_t_bits scm_tc16_regex;
  62
  63 static size_t
  64 regex_free (SCM obj)
  65 {
  66   regfree (SCM_RGX (obj));
  67   scm_gc_free (SCM_RGX (obj), sizeof(regex_t), "regex");
  68   return 0;
  69 }
  70
  71 \f
  72
  73 SCM_SYMBOL (scm_regexp_error_key, "regular-expression-syntax");
  74
  75 static SCM
  76 scm_regexp_error_msg (int regerrno, regex_t *rx)
  77 {
  78   char *errmsg;
  79   int l;
  80
  81   errmsg = scm_malloc (80);
  82   l = regerror (regerrno, rx, errmsg, 80);
  83   if (l > 80)
  84     {
  85       free (errmsg);
  86       errmsg = scm_malloc (l);
  87       regerror (regerrno, rx, errmsg, l);
  88     }
  89   return scm_take_locale_string (errmsg);
  90 }
  91
  92 SCM_DEFINE (scm_regexp_p, "regexp?", 1, 0, 0,
  93             (SCM obj),
  94             "Return @code{#t} if @var{obj} is a compiled regular expression,\n"
  95             "or @code{#f} otherwise.")
  96 #define FUNC_NAME s_scm_regexp_p
  97 {
  98   return scm_from_bool(SCM_RGXP (obj));
  99 }
 100 #undef FUNC_NAME
 101
 102 SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0, 1,
 103             (SCM pat, SCM flags),
 104             "Compile the regular expression described by @var{pat}, and\n"
 105             "return the compiled regexp structure.  If @var{pat} does not\n"
 106             "describe a legal regular expression, @code{make-regexp} throws\n"
 107             "a @code{regular-expression-syntax} error.\n"
 108             "\n"
 109             "The @var{flags} arguments change the behavior of the compiled\n"
 110             "regular expression.  The following flags may be supplied:\n"
 111             "\n"
 112             "@table @code\n"
 113             "@item regexp/icase\n"
 114             "Consider uppercase and lowercase letters to be the same when\n"
 115             "matching.\n"
 116             "@item regexp/newline\n"
 117             "If a newline appears in the target string, then permit the\n"
 118             "@samp{^} and @samp{$} operators to match immediately after or\n"
 119             "immediately before the newline, respectively.  Also, the\n"
 120             "@samp{.} and @samp{[^...]} operators will never match a newline\n"
 121             "character.  The intent of this flag is to treat the target\n"
 122             "string as a buffer containing many lines of text, and the\n"
 123             "regular expression as a pattern that may match a single one of\n"
 124             "those lines.\n"
 125             "@item regexp/basic\n"
 126             "Compile a basic (``obsolete'') regexp instead of the extended\n"
 127             "(``modern'') regexps that are the default.  Basic regexps do\n"
 128             "not consider @samp{|}, @samp{+} or @samp{?} to be special\n"
 129             "characters, and require the @samp{@{...@}} and @samp{(...)}\n"
 130             "metacharacters to be backslash-escaped (@pxref{Backslash\n"
 131             "Escapes}).  There are several other differences between basic\n"
 132             "and extended regular expressions, but these are the most\n"
 133             "significant.\n"
 134             "@item regexp/extended\n"
 135             "Compile an extended regular expression rather than a basic\n"
 136             "regexp.  This is the default behavior; this flag will not\n"
 137             "usually be needed.  If a call to @code{make-regexp} includes\n"
 138             "both @code{regexp/basic} and @code{regexp/extended} flags, the\n"
 139             "one which comes last will override the earlier one.\n"
 140             "@end table")
 141 #define FUNC_NAME s_scm_make_regexp
 142 {
 143   SCM flag;
 144   regex_t *rx;
 145   int status, cflags;
 146   char *c_pat;
 147
 148   SCM_VALIDATE_STRING (1, pat);
 149   SCM_VALIDATE_REST_ARGUMENT (flags);
 150
 151   /* Examine list of regexp flags.  If REG_BASIC is supplied, then
 152      turn off REG_EXTENDED flag (on by default). */
 153   cflags = REG_EXTENDED;
 154   flag = flags;
 155   while (!scm_is_null (flag))
 156     {
 157       if (scm_to_int (SCM_CAR (flag)) == REG_BASIC)
 158         cflags &= ~REG_EXTENDED;
 159       else
 160         cflags |= scm_to_int (SCM_CAR (flag));
 161       flag = SCM_CDR (flag);
 162     }
 163
 164   rx = scm_gc_malloc_pointerless (sizeof (regex_t), "regex");
 165   c_pat = scm_to_locale_string (pat);
 166   status = regcomp (rx, c_pat,
 167                     /* Make sure they're not passing REG_NOSUB;
 168                        regexp-exec assumes we're getting match data.  */
 169                     cflags & ~REG_NOSUB);
 170   free (c_pat);
 171   if (status != 0)
 172     {
 173       SCM errmsg = scm_regexp_error_msg (status, rx);
 174       scm_gc_free (rx, sizeof(regex_t), "regex");
 175       scm_error_scm (scm_regexp_error_key,
 176                      scm_from_locale_string (FUNC_NAME),
 177                      errmsg,
 178                      SCM_BOOL_F,
 179                      scm_list_1 (pat));
 180
 181       /* never returns */
 182     }
 183   SCM_RETURN_NEWSMOB (scm_tc16_regex, rx);
 184 }
 185 #undef FUNC_NAME
 186
 187 #ifdef HAVE_WCHAR_H
 188 /*
 189  * While regexec does respect the current locale, it returns byte
 190  * offsets instead of character offsets. This routine fixes up the
 191  * regmatch_t structures to refer to characters instead. See "Converting
 192  * a Character" in the libc manual, for more details.
 193  */
 194 static void
 195 fixup_multibyte_match (regmatch_t *matches, int nmatches, char *str)
 196 {
 197   mbstate_t state;
 198   int i;
 199   size_t char_idx, byte_idx;
 200   size_t nbytes = 1; /* just to kick off the for loop */
 201
 202   memset (&state, '\0', sizeof (state));
 203
 204   for (char_idx = byte_idx = 0; nbytes > 0; char_idx++, byte_idx += nbytes)
 205     {
 206       for (i = 0; i < nmatches; ++i)
 207         {
 208           if (matches[i].rm_so == byte_idx)
 209             matches[i].rm_so = char_idx;
 210           if (matches[i].rm_eo == byte_idx)
 211             matches[i].rm_eo = char_idx;
 212         }
 213
 214       nbytes = mbrlen (str + byte_idx, MB_LEN_MAX, &state);
 215       if (nbytes == (size_t) -2 || nbytes == (size_t) -1)
 216         /* Something is wrong. Shouldn't be possible, as the regex match
 217            succeeded.  */
 218         abort ();
 219     }
 220
 221 }
 222 #endif
 223
 224 SCM_DEFINE (scm_regexp_exec, "regexp-exec", 2, 2, 0,
 225             (SCM rx, SCM str, SCM start, SCM flags),
 226             "Match the compiled regular expression @var{rx} against\n"
 227             "@code{str}.  If the optional integer @var{start} argument is\n"
 228             "provided, begin matching from that position in the string.\n"
 229             "Return a match structure describing the results of the match,\n"
 230             "or @code{#f} if no match could be found.\n"
 231             "\n"
 232             "The @var{flags} arguments change the matching behavior.\n"
 233             "The following flags may be supplied:\n"
 234             "\n"
 235             "@table @code\n"
 236             "@item regexp/notbol\n"
 237             "Operator @samp{^} always fails (unless @code{regexp/newline}\n"
 238             "is used).  Use this when the beginning of the string should\n"
 239             "not be considered the beginning of a line.\n"
 240             "@item regexp/noteol\n"
 241             "Operator @samp{$} always fails (unless @code{regexp/newline}\n"
 242             "is used).  Use this when the end of the string should not be\n"
 243             "considered the end of a line.\n"
 244             "@end table")
 245 #define FUNC_NAME s_scm_regexp_exec
 246 {
 247   /* We used to have an SCM_DEFER_INTS, and then later an
 248      SCM_CRITICAL_SECTION_START, around the regexec() call.  Can't quite
 249      remember what defer ints was for, but a critical section would only be
 250      wanted now if we think regexec() is not thread-safe.  The posix spec
 251
 252      http://www.opengroup.org/onlinepubs/009695399/functions/regcomp.html
 253
 254      reads like regexec is meant to be both thread safe and reentrant
 255      (mentioning simultaneous use in threads, and in signal handlers).  So
 256      for now believe no protection needed.  */
 257
 258   int status, nmatches, offset;
 259   regmatch_t *matches;
 260   char *c_str;
 261   SCM mvec = SCM_BOOL_F;
 262   SCM substr;
 263
 264   SCM_VALIDATE_RGXP (1, rx);
 265   SCM_VALIDATE_STRING (2, str);
 266
 267   if (SCM_UNBNDP (start))
 268     {
 269       substr = str;
 270       offset = 0;
 271     }
 272   else
 273     {
 274       substr = scm_substring (str, start, SCM_UNDEFINED);
 275       offset = scm_to_int (start);
 276     }
 277
 278   if (SCM_UNBNDP (flags))
 279     flags = SCM_INUM0;
 280
 281   /* re_nsub doesn't account for the `subexpression' representing the
 282      whole regexp, so add 1 to nmatches. */
 283
 284   c_str = scm_to_locale_string (substr);
 285
 286   nmatches = SCM_RGX(rx)->re_nsub + 1;
 287   matches = scm_malloc (sizeof (regmatch_t) * nmatches);
 288   status = regexec (SCM_RGX (rx), c_str, nmatches, matches,
 289                     scm_to_int (flags));
 290
 291 #ifdef HAVE_WCHAR_H
 292   if (!status)
 293     fixup_multibyte_match (matches, nmatches, c_str);
 294 #endif
 295
 296   free (c_str);
 297
 298   if (!status)
 299     {
 300       int i;
 301       /* The match vector must include a cell for the string that was matched,
 302          so add 1. */
 303       mvec = scm_c_make_vector (nmatches + 1, SCM_UNSPECIFIED);
 304       SCM_SIMPLE_VECTOR_SET(mvec,0, str);
 305       for (i = 0; i < nmatches; ++i)
 306         if (matches[i].rm_so == -1)
 307           SCM_SIMPLE_VECTOR_SET(mvec, i+1,
 308                          scm_cons (scm_from_int (-1), scm_from_int (-1)));
 309         else
 310           SCM_SIMPLE_VECTOR_SET(mvec, i+1,
 311                          scm_cons (scm_from_long (matches[i].rm_so + offset),
 312                                    scm_from_long (matches[i].rm_eo + offset)));
 313     }
 314   free (matches);
 315
 316   if (status != 0 && status != REG_NOMATCH)
 317     scm_error_scm (scm_regexp_error_key,
 318                    scm_from_locale_string (FUNC_NAME),
 319                    scm_regexp_error_msg (status, SCM_RGX (rx)),
 320                    SCM_BOOL_F, SCM_BOOL_F);
 321   return mvec;
 322 }
 323 #undef FUNC_NAME
 324
 325 void
 326 scm_init_regex_posix ()
 327 {
 328   scm_tc16_regex = scm_make_smob_type ("regexp", sizeof (regex_t));
 329   scm_set_smob_free (scm_tc16_regex, regex_free);
 330
 331   /* Compilation flags.  */
 332   scm_c_define ("regexp/basic",    scm_from_int (REG_BASIC));
 333   scm_c_define ("regexp/extended", scm_from_int (REG_EXTENDED));
 334   scm_c_define ("regexp/icase",    scm_from_int (REG_ICASE));
 335   scm_c_define ("regexp/newline",  scm_from_int (REG_NEWLINE));
 336
 337   /* Execution flags.  */
 338   scm_c_define ("regexp/notbol", scm_from_int (REG_NOTBOL));
 339   scm_c_define ("regexp/noteol", scm_from_int (REG_NOTEOL));
 340
 341 #include "libguile/regex-posix.x"
 342
 343   scm_add_feature ("regex");
 344 }
 345
 346 /*
 347   Local Variables:
 348   c-file-style: "gnu"
 349   End:
 350 */