source: perlconfig.c @ 4de643d

owl
Last change on this file since 4de643d was dab82f29, checked in by James M. Kretchmar <kretch@mit.edu>, 16 years ago
Don't crash on mobile device AIM messages [BZ 20] Don't crash when sending to someone not on AIM buddy list [BZ 94] Fix overflow vulerability in zwrite.c and zcrypt.c Add stack protector and -D_FORTIFY_SOURCE=2 where possible Fix hang [barnowl 4c46dfdebc294ca24fef59924f01688b8ee07dee] Fix segfault on missing subs [barnowl 99dabeed7de6d19acb50f1e73aa0bfe5f9469c02] Fix zcrypt bufffer size bug [barnowl 559076cd86edc3a8317819814dd5877b8bc7c3cb] Fix double free [barnowl e97c4a306ae2c9d2147d83da29fee59918198e70] Memory leak fix [barnowl c0a90c2c7ab97b9465c9873757faf312faa0021e] Memory leak fix [barnowl 95caa16b2e9ba10770d87d0955198c14c2d0e16a] Memory leak fix [barnowl 1716fed8c2650e46892cf6571555eac937266c6e] Add getstyle command [barnowl 216c73421653e3ef0e957aa9a9804e208a77c80e] Binary search for msgid [barnowl 0c8ab5eadbb6ecc97a120c91b9a824b33538c764] File-handle leak [barnowl e78397d6ac5da0de31a4e269c0ba7f3d691857a3] Fix delay in jump from top to bottom [barnowl 801b7ac63b962640debbcfd422cb9a60da5fea31] Load subs in chunks [barnowl 93e883d60051b80bf6d35391f9d76fd7dfd198e3] Load subs in chunks [barnowl f6050ee9b0a171a5031f84409eb181062afacd18] Better zsig logging [barnowl d857b667a5a9b108b1a2a26b4a5513bef2b53f80] free() -> owlfree() [barnowl d524c838ac7c115628424b8ac171c3489622ea3a] Escape AIM users in smartfilters [barnowl af9b92e3e7ccb7de276a94b5c7e5861b24e71eff] Better regex escape chars [barnowl 80e54a7631f091be8c9762adb9746bad38104738] Deal with quotes in smart filters [barnowl 4099cf83702763fa8d1efc4f1582a605431bdb77] Deal with 0 length zephyr fields [barnowl 128171aaf7cefa91a4bb1eada93a19d8fd0c355c] Deal with 0 length zephyr fields [barnowl 50e29e35c64d64e223d378d350a7bc4f038d78f5] Deal with 0 length zephyr fields [barnowl 804ab8af8b6d00bcd7e2402df892db8fbd61a3ec] Leave curmsg on screen after resize [barnowl c0f9e3009bc03e80a44de64cd5f2b4033290236e] Rip out brower stuff [barnowl 8e5935d11c699a7ce5a3e6e9a47799564c696d6a] Rip out browser stuff [barnowl 4f15e8e9ceada0d4b2cc969ebf43b0a1fb3709ea] No passwords in command history [barnowl 6e400cc71aa59e041dce677aadf50dc1f25228e2] Format NOC mssages [barnowl a1bb1980e4bca23b8329cc0e7c0bd5027055ea0a] Expand ~ in loadsubs [barnowl 27d8d835dc6d58c08fae10e75aae306c49215143] Expand ~ in source [barnowl 10d67d57cb29221f63a43a30643c697fc7b38911] Only use resizeterm() if it's available Debian backports Change license to GPLv3
  • Property mode set to 100644
File size: 8.9 KB
Line 
1/* Copyright (c) 2002,2003,2004,2009 James M. Kretchmar
2 *
3 * This file is part of Owl.
4 *
5 * Owl is free software: you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation, either version 3 of the License, or
8 * (at your option) any later version.
9 *
10 * Owl is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with Owl.  If not, see <http://www.gnu.org/licenses/>.
17 *
18 * ---------------------------------------------------------------
19 *
20 * As of Owl version 2.1.12 there are patches contributed by
21 * developers of the the branched BarnOwl project, Copyright (c)
22 * 2006-2008 The BarnOwl Developers. All rights reserved.
23 */
24
25#include <stdio.h>
26#include <stdlib.h>
27#include <string.h>
28#include <sys/types.h>
29#include <sys/stat.h>
30#include <errno.h>
31#include "owl.h"
32#include <perl.h>
33#include "XSUB.h"
34
35static const char fileIdent[] = "$Id$";
36
37extern char *owl_perlwrap_codebuff;
38
39extern XS(boot_owl);
40
41static void owl_perl_xs_init(pTHX)
42{
43  char *file = __FILE__;
44  dXSUB_SYS;
45  {
46    newXS("owl::bootstrap", boot_owl, file);
47  }
48}
49
50SV *owl_perlconfig_message2hashref(owl_message *m)  /*noproto*/
51{
52  HV *h;
53  SV *hr;
54  char *ptr, *blessas;
55  int i, j;
56
57  if (!m) return &PL_sv_undef;
58  h = newHV();
59
60#define MSG2H(h,field) hv_store(h, #field, strlen(#field), \
61                              newSVpv(owl_message_get_##field(m),0), 0)
62
63  if (owl_message_is_type_zephyr(m)
64      && owl_message_is_direction_in(m)) {
65    /* Handle zephyr-specific fields... */
66    AV *av_zfields;
67
68    av_zfields = newAV();
69    j=owl_zephyr_get_num_fields(owl_message_get_notice(m));
70    for (i=0; i<j; i++) {
71      ptr=owl_zephyr_get_field(owl_message_get_notice(m), i+1);
72      av_push(av_zfields, newSVpvn(ptr, strlen(ptr)));
73      owl_free(ptr);
74    }
75    hv_store(h, "fields", strlen("fields"), newRV_noinc((SV*)av_zfields), 0);
76
77    hv_store(h, "auth", strlen("auth"), 
78             newSVpv(owl_zephyr_get_authstr(owl_message_get_notice(m)),0),0);
79  }
80
81  MSG2H(h, type);
82  MSG2H(h, direction);
83  MSG2H(h, class);
84  MSG2H(h, instance);
85  MSG2H(h, sender);
86  MSG2H(h, realm);
87  MSG2H(h, recipient);
88  MSG2H(h, opcode);
89  MSG2H(h, hostname);
90  MSG2H(h, body);
91  MSG2H(h, login);
92  MSG2H(h, zsig);
93  MSG2H(h, zwriteline);
94  if (owl_message_get_header(m)) {
95    MSG2H(h, header); 
96  }
97  hv_store(h, "time", strlen("time"), newSVpv(owl_message_get_timestr(m),0),0);
98  hv_store(h, "id", strlen("id"), newSViv(owl_message_get_id(m)),0);
99  hv_store(h, "deleted", strlen("deleted"), newSViv(owl_message_is_delete(m)),0);
100  hv_store(h, "private", strlen("private"), newSViv(owl_message_is_private(m)),0);
101
102  if (owl_message_is_type_zephyr(m))       blessas = "owl::Message::Zephyr";
103  else if (owl_message_is_type_aim(m))     blessas = "owl::Message::AIM";
104  else if (owl_message_is_type_admin(m))   blessas = "owl::Message::Admin";
105  else if (owl_message_is_type_generic(m)) blessas = "owl::Message::Generic";
106  else                                     blessas = "owl::Message";
107
108  hr = sv_2mortal(newRV_noinc((SV*)h));
109  return sv_bless(hr, gv_stashpv(blessas,0));
110}
111
112
113SV *owl_perlconfig_curmessage2hashref(void) /*noproto*/
114{
115  int curmsg;
116  owl_view *v;
117  v=owl_global_get_current_view(&g);
118  if (owl_view_get_size(v) < 1) {
119    return &PL_sv_undef;
120  }
121  curmsg=owl_global_get_curmsg(&g);
122  return owl_perlconfig_message2hashref(owl_view_get_element(v, curmsg));
123}
124
125
126/* Calls in a scalar context, passing it a hash reference.
127   If return value is non-null, caller must free. */
128char *owl_perlconfig_call_with_message(char *subname, owl_message *m)
129{
130  dSP ;
131  int count, len;
132  SV *msgref, *srv;
133  char *out, *preout;
134 
135  ENTER ;
136  SAVETMPS;
137 
138  PUSHMARK(SP) ;
139  msgref = owl_perlconfig_message2hashref(m);
140  XPUSHs(msgref);
141  PUTBACK ;
142 
143  count = call_pv(subname, G_SCALAR|G_EVAL|G_KEEPERR);
144 
145  SPAGAIN ;
146
147  if (SvTRUE(ERRSV)) {
148    STRLEN n_a;
149    owl_function_error("Perl Error: '%s'", SvPV(ERRSV, n_a));
150    /* and clear the error */
151    sv_setsv (ERRSV, &PL_sv_undef);
152  }
153
154  if (count != 1) {
155    fprintf(stderr, "bad perl!  no biscuit!  returned wrong count!\n");
156    abort();
157  }
158
159  srv = POPs;
160
161  if (srv) {
162    preout=SvPV(srv, len);
163    out = owl_malloc(strlen(preout)+1);
164    strncpy(out, preout, len);
165    out[len] = '\0';
166  } else {
167    out = NULL;
168  }
169 
170  PUTBACK ;
171  FREETMPS ;
172  LEAVE ;
173
174  return out;
175}
176
177char *owl_perlconfig_readconfig(char *file)
178{
179  int ret, fd;
180  PerlInterpreter *p;
181  char filename[1024];
182  char *embedding[5];
183  char *err;
184  struct stat statbuff;
185
186  if (file==NULL) {
187    sprintf(filename, "%s/%s", getenv("HOME"), ".owlconf");
188  } else {
189    strcpy(filename, file);
190  }
191  embedding[0]="";
192  embedding[1]=filename;
193  embedding[2]=0;
194
195  /* create and initialize interpreter */
196  p=perl_alloc();
197  owl_global_set_perlinterp(&g, (void*)p);
198  perl_construct(p);
199
200  owl_global_set_no_have_config(&g);
201
202  /* Before we let perl have at it, we'll do our own checks on the the
203   *  file to see if it's present, readnable etc.
204   */
205
206  /* Not present, start without it */
207  ret=stat(filename, &statbuff);
208  if (ret) {
209    return(NULL);
210  }
211
212  /* present, but stat thinks it's unreadable */
213  if (! (statbuff.st_mode & S_IREAD)) {
214    return(owl_sprintf("%s present but not readable", filename));
215  }
216
217  /* can we open it? */
218  fd=open(filename, O_RDONLY);
219  if (fd==-1) {
220    return(owl_sprintf("could not open %s for reading", filename));
221  }
222  close(fd);
223
224  ret=perl_parse(p, owl_perl_xs_init, 2, embedding, NULL);
225  if (ret || SvTRUE(ERRSV)) {
226    STRLEN n_a;
227    err=owl_strdup(SvPV(ERRSV, n_a));
228    sv_setsv(ERRSV, &PL_sv_undef);     /* and clear the error */
229    return(err);
230  }
231
232  ret=perl_run(p);
233  if (ret || SvTRUE(ERRSV)) {
234    STRLEN n_a;
235    err=owl_strdup(SvPV(ERRSV, n_a));
236    sv_setsv(ERRSV, &PL_sv_undef);     /* and clear the error */
237    return(err);
238  }
239
240  owl_global_set_have_config(&g);
241
242  /* create legacy variables */
243  perl_get_sv("owl::id", TRUE);
244  perl_get_sv("owl::class", TRUE);
245  perl_get_sv("owl::instance", TRUE);
246  perl_get_sv("owl::recipient", TRUE);
247  perl_get_sv("owl::sender", TRUE);
248  perl_get_sv("owl::realm", TRUE);
249  perl_get_sv("owl::opcode", TRUE);
250  perl_get_sv("owl::zsig", TRUE);
251  perl_get_sv("owl::msg", TRUE);
252  perl_get_sv("owl::time", TRUE);
253  perl_get_sv("owl::host", TRUE);
254  perl_get_av("owl::fields", TRUE);
255 
256  perl_eval_pv(owl_perlwrap_codebuff, FALSE);
257
258  if (SvTRUE(ERRSV)) {
259    STRLEN n_a;
260    err=owl_strdup(SvPV(ERRSV, n_a));
261    sv_setsv (ERRSV, &PL_sv_undef);     /* and clear the error */
262    return(err);
263  }
264
265  /* check if we have the formatting function */
266  if (owl_perlconfig_is_function("owl::format_msg")) {
267    owl_global_set_config_format(&g, 1);
268  }
269
270  return(NULL);
271}
272
273/* returns whether or not a function exists */
274int owl_perlconfig_is_function(char *fn) {
275  if (perl_get_cv(fn, FALSE)) return(1);
276  else return(0);
277}
278
279/* returns 0 on success */
280int owl_perlconfig_get_hashkeys(char *hashname, owl_list *l)
281{
282  HV *hv;
283  HE *he;
284  char *key;
285  I32 i;
286
287  if (owl_list_create(l)) return(-1);
288  hv = get_hv(hashname, FALSE);
289  if (!hv) return(-1);
290  i = hv_iterinit(hv);
291  while ((he = hv_iternext(hv))) {
292    key = hv_iterkey(he, &i);
293    if (key) {
294      owl_list_append_element(l, owl_strdup(key));
295    }
296  }
297  return(0);
298}
299
300/* caller is responsible for freeing returned string */
301char *owl_perlconfig_execute(char *line)
302{
303  STRLEN len;
304  SV *response;
305  char *out, *preout;
306
307  if (!owl_global_have_config(&g)) return NULL;
308
309  /* execute the subroutine */
310  response = perl_eval_pv(line, FALSE);
311
312  if (SvTRUE(ERRSV)) {
313    STRLEN n_a;
314    owl_function_error("Perl Error: '%s'", SvPV(ERRSV, n_a));
315    sv_setsv (ERRSV, &PL_sv_undef);     /* and clear the error */
316  }
317
318  preout=SvPV(response, len);
319  /* leave enough space in case we have to add a newline */
320  out = owl_malloc(strlen(preout)+2);
321  strncpy(out, preout, len);
322  out[len] = '\0';
323  if (!strlen(out) || out[strlen(out)-1]!='\n') {
324    strcat(out, "\n");
325  }
326
327  return(out);
328}
329
330char *owl_perlconfig_getmsg(owl_message *m, int mode, char *subname)
331{ 
332  /* if mode==1 we are doing message formatting.  The returned
333   * formatted message needs to be freed by the caller.
334   *
335   * if mode==0 we are just doing the message-has-been-received
336   * thing.
337   */
338  if (!owl_global_have_config(&g)) return(NULL);
339 
340  /* run the procedure corresponding to the mode */
341  if (mode==1) {
342    char *ret = NULL;
343    ret = owl_perlconfig_call_with_message(subname?subname
344                                           :"owl::_format_msg_legacy_wrap", m);
345    if (!ret) {
346      ret = owl_sprintf("@b([Perl Message Formatting Failed!])\n");
347    } 
348    return ret;
349  } else {
350    char *ptr = NULL;
351    if (owl_perlconfig_is_function("owl::receive_msg")) {
352      ptr = owl_perlconfig_call_with_message(subname?subname
353                                       :"owl::_receive_msg_legacy_wrap", m);
354    }
355    if (ptr) owl_free(ptr);
356    return(NULL);
357  }
358}
Note: See TracBrowser for help on using the repository browser.