apps/irssi/src/perl/perl-signals.c

   1 /*
   2  perl-signals.c : irssi
   3
   4     Copyright (C) 1999-2001 Timo Sirainen
   5
   6     This program is free software; you can redistribute it and/or modify
   7     it under the terms of the GNU General Public License as published by
   8     the Free Software Foundation; either version 2 of the License, or
   9     (at your option) any later version.
  10
  11     This program is distributed in the hope that it will be useful,
  12     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14     GNU General Public License for more details.
  15
  16     You should have received a copy of the GNU General Public License along
  17     with this program; if not, write to the Free Software Foundation, Inc.,
  18     51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  19 */
  20
  21 #define NEED_PERL_H
  22 #include "module.h"
  23 #include "modules.h"
  24 #include "signals.h"
  25 #include "commands.h"
  26 #include "servers.h"
  27
  28 #include "perl-core.h"
  29 #include "perl-common.h"
  30 #include "perl-signals.h"
  31
  32 typedef struct {
  33         PERL_SCRIPT_REC *script;
  34         int signal_id;
  35         char *signal;
  36         SV *func;
  37 } PERL_SIGNAL_REC;
  38
  39 typedef struct {
  40         char *signal;
  41         char *args[7];
  42         int dynamic;
  43 } PERL_SIGNAL_ARGS_REC;
  44
  45 #include "perl-signals-list.h"
  46
  47 static GHashTable *signals;
  48 static GHashTable *perl_signal_args_hash;
  49 static GSList *perl_signal_args_partial;
  50
  51 static PERL_SIGNAL_ARGS_REC *perl_signal_args_find(int signal_id)
  52 {
  53         PERL_SIGNAL_ARGS_REC *rec;
  54         GSList *tmp;
  55         const char *signame;
  56
  57         rec = g_hash_table_lookup(perl_signal_args_hash,
  58                                   GINT_TO_POINTER(signal_id));
  59         if (rec != NULL) return rec;
  60
  61         /* try to find by name */
  62         signame = signal_get_id_str(signal_id);
  63         for (tmp = perl_signal_args_partial; tmp != NULL; tmp = tmp->next) {
  64                 rec = tmp->data;
  65
  66                 if (strncmp(rec->signal, signame, strlen(rec->signal)) == 0)
  67                         return rec;
  68         }
  69
  70         return NULL;
  71 }
  72
  73 void perl_signal_args_to_c(
  74         void (*callback)(void *, void **), void *cb_arg,
  75         int signal_id, SV **args, size_t n_args)
  76 {
  77         union {
  78                 int v_int;
  79                 unsigned long v_ulong;
  80                 GSList *v_gslist;
  81                 GList *v_glist;
  82         } saved_args[SIGNAL_MAX_ARGUMENTS];
  83         void *p[SIGNAL_MAX_ARGUMENTS];
  84         PERL_SIGNAL_ARGS_REC *rec;
  85         size_t n;
  86
  87         if (!(rec = perl_signal_args_find(signal_id))) {
  88                 const char *name = signal_get_id_str(signal_id);
  89                 if (!name) {
  90                         croak("%d is not a known signal id", signal_id);
  91                 }
  92                 croak("\"%s\" is not a registered signal", name);
  93         }
  94
  95         for (n = 0; n < SIGNAL_MAX_ARGUMENTS && n < n_args && rec->args[n] != NULL; ++n) {
  96                 void *c_arg;
  97                 SV *arg = args[n];
  98
  99                 if (!SvOK(arg)) {
 100                         c_arg = NULL;
 101                 } else if (strcmp(rec->args[n], "string") == 0) {
 102                         c_arg = SvPV_nolen(arg);
 103                 } else if (strcmp(rec->args[n], "int") == 0) {
 104                         c_arg = (void *)SvIV(arg);
 105                 } else if (strcmp(rec->args[n], "ulongptr") == 0) {
 106                         saved_args[n].v_ulong = SvUV(arg);
 107                         c_arg = &saved_args[n].v_ulong;
 108                 } else if (strcmp(rec->args[n], "intptr") == 0) {
 109                         saved_args[n].v_int = SvIV(SvRV(arg));
 110                         c_arg = &saved_args[n].v_int;
 111                 } else if (strncmp(rec->args[n], "glistptr_", 9) == 0) {
 112                         GList *gl;
 113                         int is_str;
 114                         AV *av;
 115                         SV *t;
 116                         int count;
 117
 118                         t = SvRV(arg);
 119                         if (SvTYPE(t) != SVt_PVAV) {
 120                                 croak("Not an ARRAY reference");
 121                         }
 122                         av = (AV *)t;
 123
 124                         is_str = strcmp(rec->args[n]+9, "char*") == 0;
 125
 126                         gl = NULL;
 127                         count = av_len(av) + 1;
 128                         while (count-- > 0) {
 129                                 SV **px = av_fetch(av, count, 0);
 130                                 SV *x = px ? *px : NULL;
 131                                 gl = g_list_prepend(
 132                                         gl,
 133                                         x == NULL ? NULL :
 134                                         is_str ? g_strdup(SvPV_nolen(x)) :
 135                                         irssi_ref_object(x)
 136                                 );
 137                         }
 138                         saved_args[n].v_glist = gl;
 139                         c_arg = &saved_args[n].v_glist;
 140                 } else if (strncmp(rec->args[n], "gslist_", 7) == 0) {
 141                         GSList *gsl;
 142                         AV *av;
 143                         SV *t;
 144                         int count;
 145
 146                         t = SvRV(arg);
 147                         if (SvTYPE(t) != SVt_PVAV) {
 148                                 croak("Not an ARRAY reference");
 149                         }
 150                         av = (AV *)t;
 151
 152                         gsl = NULL;
 153                         count = av_len(av) + 1;
 154                         while (count-- > 0) {
 155                                 SV **x = av_fetch(av, count, 0);
 156                                 gsl = g_slist_prepend(
 157                                         gsl,
 158                                         x == NULL ? NULL :
 159                                         irssi_ref_object(*x)
 160                                 );
 161                         }
 162                         c_arg = saved_args[n].v_gslist = gsl;
 163                 } else {
 164                         c_arg = irssi_ref_object(arg);
 165                 }
 166
 167                 p[n] = c_arg;
 168         }
 169
 170         for (; n < SIGNAL_MAX_ARGUMENTS; ++n) {
 171                 p[n] = NULL;
 172         }
 173
 174         callback(cb_arg, p);
 175
 176         for (n = 0; n < SIGNAL_MAX_ARGUMENTS && n < n_args && rec->args[n] != NULL; ++n) {
 177                 SV *arg = args[n];
 178
 179                 if (!SvOK(arg)) {
 180                         continue;
 181                 }
 182
 183                 if (strcmp(rec->args[n], "intptr") == 0) {
 184                         SV *t = SvRV(arg);
 185                         SvIOK_only(t);
 186                         SvIV_set(t, saved_args[n].v_int);
 187                 } else if (strncmp(rec->args[n], "gslist_", 7) == 0) {
 188                         g_slist_free(saved_args[n].v_gslist);
 189                 } else if (strncmp(rec->args[n], "glistptr_", 9) == 0) {
 190                         int is_iobject, is_str;
 191                         AV *av;
 192                         GList *gl, *tmp;
 193
 194                         is_iobject = strcmp(rec->args[n]+9, "iobject") == 0;
 195                         is_str = strcmp(rec->args[n]+9, "char*") == 0;
 196
 197                         av = (AV *)SvRV(arg);
 198                         av_clear(av);
 199
 200                         gl = saved_args[n].v_glist;
 201                         for (tmp = gl; tmp != NULL; tmp = tmp->next) {
 202                                 av_push(av,
 203                                         is_iobject ? iobject_bless((SERVER_REC *)tmp->data) :
 204                                         is_str ? new_pv(tmp->data) :
 205                                         irssi_bless_plain(rec->args[n]+9, tmp->data)
 206                                 );
 207                         }
 208
 209                         if (is_str) {
 210                                 g_list_foreach(gl, (GFunc)g_free, NULL);
 211                         }
 212                         g_list_free(gl);
 213                 }
 214         }
 215 }
 216
 217 static void perl_call_signal(PERL_SCRIPT_REC *script, SV *func,
 218                              int signal_id, gconstpointer *args)
 219 {
 220         dSP;
 221
 222         PERL_SIGNAL_ARGS_REC *rec;
 223         SV *sv, *perlarg, *saved_args[SIGNAL_MAX_ARGUMENTS];
 224         AV *av;
 225         void *arg;
 226         int n;
 227
 228
 229         ENTER;
 230         SAVETMPS;
 231
 232         PUSHMARK(sp);
 233
 234         /* push signal argument to perl stack */
 235         rec = perl_signal_args_find(signal_id);
 236
 237         memset(saved_args, 0, sizeof(saved_args));
 238         for (n = 0; n < SIGNAL_MAX_ARGUMENTS &&
 239                     rec != NULL && rec->args[n] != NULL; n++) {
 240                 arg = (void *) args[n];
 241
 242                 if (strncmp(rec->args[n], "glistptr_", 9) == 0) {
 243                         /* pointer to linked list - push as AV */
 244                         GList *tmp, **ptr;
 245                         int is_iobject, is_str;
 246
 247                         is_iobject = strcmp(rec->args[n]+9, "iobject") == 0;
 248                         is_str = strcmp(rec->args[n]+9, "char*") == 0;
 249                         av = newAV();
 250
 251                         ptr = arg;
 252                         for (tmp = *ptr; tmp != NULL; tmp = tmp->next) {
 253                                 sv = is_iobject ? iobject_bless((SERVER_REC *) tmp->data) :
 254                                         is_str ? new_pv(tmp->data) :
 255                                         irssi_bless_plain(rec->args[n]+9, tmp->data);
 256                                 av_push(av, sv);
 257                         }
 258
 259                         saved_args[n] = perlarg = newRV_noinc((SV *) av);
 260                 } else if (strcmp(rec->args[n], "int") == 0)
 261                         perlarg = newSViv((IV)arg);
 262                 else if (arg == NULL)
 263                         perlarg = &PL_sv_undef;
 264                 else if (strcmp(rec->args[n], "string") == 0)
 265                         perlarg = new_pv(arg);
 266                 else if (strcmp(rec->args[n], "ulongptr") == 0)
 267                         perlarg = newSViv(*(unsigned long *) arg);
 268                 else if (strcmp(rec->args[n], "intptr") == 0)
 269                         saved_args[n] = perlarg = newRV_noinc(newSViv(*(int *) arg));
 270                 else if (strncmp(rec->args[n], "gslist_", 7) == 0) {
 271                         /* linked list - push as AV */
 272                         GSList *tmp;
 273                         int is_iobject;
 274
 275                         is_iobject = strcmp(rec->args[n]+7, "iobject") == 0;
 276                         av = newAV();
 277                         for (tmp = arg; tmp != NULL; tmp = tmp->next) {
 278                                 sv = is_iobject ? iobject_bless((SERVER_REC *) tmp->data) :
 279                                         irssi_bless_plain(rec->args[n]+7, tmp->data);
 280                                 av_push(av, sv);
 281                         }
 282
 283                         perlarg = newRV_noinc((SV *) av);
 284                 } else if (strcmp(rec->args[n], "iobject") == 0) {
 285                         /* "irssi object" - any struct that has
 286                            "int type; int chat_type" as it's first
 287                            variables (server, channel, ..) */
 288                         perlarg = iobject_bless((SERVER_REC *) arg);
 289                 } else if (strcmp(rec->args[n], "siobject") == 0) {
 290                         /* "simple irssi object" - any struct that has
 291                            int type; as it's first variable (dcc) */
 292                         perlarg = simple_iobject_bless((SERVER_REC *) arg);
 293                 } else {
 294                         /* blessed object */
 295                         perlarg = plain_bless(arg, rec->args[n]);
 296                 }
 297                 XPUSHs(sv_2mortal(perlarg));
 298         }
 299
 300         PUTBACK;
 301         perl_call_sv(func, G_EVAL|G_DISCARD);
 302         SPAGAIN;
 303
 304         if (SvTRUE(ERRSV)) {
 305                 char *error = g_strdup(SvPV(ERRSV, PL_na));
 306                 signal_emit("script error", 2, script, error);
 307                 g_free(error);
 308                 rec = NULL;
 309         }
 310
 311         /* restore arguments the perl script modified */
 312         for (n = 0; n < SIGNAL_MAX_ARGUMENTS &&
 313                     rec != NULL && rec->args[n] != NULL; n++) {
 314                 arg = (void *) args[n];
 315
 316                 if (saved_args[n] == NULL)
 317                         continue;
 318
 319                 if (strcmp(rec->args[n], "intptr") == 0) {
 320                         int *val = arg;
 321                         *val = SvIV(SvRV(saved_args[n]));
 322                 } else if (strncmp(rec->args[n], "glistptr_", 9) == 0) {
 323                         GList **ret = arg;
 324                         GList *out = NULL;
 325                         void *val;
 326                         STRLEN len;
 327                         int count;
 328
 329                         av = (AV *) SvRV(saved_args[n]);
 330                         count = av_len(av);
 331                         while (count-- >= 0) {
 332                                 sv = av_shift(av);
 333                                 if (SvPOKp(sv))
 334                                         val = g_strdup(SvPV(sv, len));
 335                                 else
 336                                         val = GINT_TO_POINTER(SvIV(sv));
 337
 338                                 out = g_list_append(out, val);
 339                         }
 340
 341                         if (strcmp(rec->args[n]+9, "char*") == 0)
 342                                 g_list_foreach(*ret, (GFunc) g_free, NULL);
 343                         g_list_free(*ret);
 344                         *ret = out;
 345                 }
 346         }
 347
 348         PUTBACK;
 349         FREETMPS;
 350         LEAVE;
 351 }
 352
 353 static void sig_func(const void *p1, const void *p2,
 354                      const void *p3, const void *p4,
 355                      const void *p5, const void *p6)
 356 {
 357         PERL_SIGNAL_REC *rec;
 358         const void *args[6];
 359
 360         args[0] = p1; args[1] = p2; args[2] = p3;
 361         args[3] = p4; args[4] = p5; args[5] = p6;
 362
 363         rec = signal_get_user_data();
 364         perl_call_signal(rec->script, rec->func, signal_get_emitted_id(), args);
 365 }
 366
 367 static void perl_signal_add_full_int(const char *signal, SV *func,
 368                                      int priority, int command,
 369                                      const char *category)
 370 {
 371         PERL_SCRIPT_REC *script;
 372         PERL_SIGNAL_REC *rec;
 373         GSList **siglist;
 374         void *signal_idp;
 375
 376         g_return_if_fail(signal != NULL);
 377         g_return_if_fail(func != NULL);
 378
 379         script = perl_script_find_package(perl_get_package());
 380         g_return_if_fail(script != NULL);
 381
 382         rec = g_new(PERL_SIGNAL_REC, 1);
 383         rec->script = script;
 384         rec->signal_id = signal_get_uniq_id(signal);
 385         rec->signal = g_strdup(signal);
 386         rec->func = perl_func_sv_inc(func, perl_get_package());
 387
 388         if (command || strncmp(signal, "command ", 8) == 0) {
 389                 /* we used Irssi::signal_add() instead of
 390                    Irssi::command_bind() - oh well, allow this.. */
 391                 command_bind_full(MODULE_NAME, priority, signal+8, -1,
 392                                   category, sig_func, rec);
 393         } else {
 394                 signal_add_full_id(MODULE_NAME, priority, rec->signal_id,
 395                                    sig_func, rec);
 396         }
 397
 398         signal_idp = GINT_TO_POINTER(rec->signal_id);
 399         siglist = g_hash_table_lookup(signals, signal_idp);
 400         if (siglist == NULL) {
 401                 siglist = g_new0(GSList *, 1);
 402                 g_hash_table_insert(signals, signal_idp, siglist);
 403         }
 404
 405         *siglist = g_slist_append(*siglist, rec);
 406 }
 407
 408 void perl_signal_add_full(const char *signal, SV *func, int priority)
 409 {
 410         perl_signal_add_full_int(signal, func, priority, FALSE, NULL);
 411 }
 412
 413 static void perl_signal_destroy(PERL_SIGNAL_REC *rec)
 414 {
 415         if (strncmp(rec->signal, "command ", 8) == 0)
 416                 command_unbind_full(rec->signal+8, sig_func, rec);
 417         else
 418                 signal_remove_id(rec->signal_id, sig_func, rec);
 419
 420         SvREFCNT_dec(rec->func);
 421         g_free(rec->signal);
 422         g_free(rec);
 423 }
 424
 425 static void perl_signal_remove_list_one(GSList **siglist, PERL_SIGNAL_REC *rec)
 426 {
 427         *siglist = g_slist_remove(*siglist, rec);
 428         if (*siglist == NULL) {
 429                 g_free(siglist);
 430                 g_hash_table_remove(signals, GINT_TO_POINTER(rec->signal_id));
 431         }
 432
 433         perl_signal_destroy(rec);
 434 }
 435
 436 #define sv_func_cmp(f1, f2) \
 437         (f1 == f2 || (SvPOK(f1) && SvPOK(f2) && \
 438                 strcmp((char *) SvPV_nolen(f1), (char *) SvPV_nolen(f2)) == 0))
 439
 440 static void perl_signal_remove_list(GSList **list, SV *func)
 441 {
 442         GSList *tmp;
 443
 444         for (tmp = *list; tmp != NULL; tmp = tmp->next) {
 445                 PERL_SIGNAL_REC *rec = tmp->data;
 446
 447                 if (sv_func_cmp(rec->func, func)) {
 448                         perl_signal_remove_list_one(list, rec);
 449                         break;
 450                 }
 451         }
 452 }
 453
 454 void perl_signal_remove(const char *signal, SV *func)
 455 {
 456         GSList **list;
 457         void *signal_idp;
 458
 459         signal_idp = GINT_TO_POINTER(signal_get_uniq_id(signal));
 460         list = g_hash_table_lookup(signals, signal_idp);
 461
 462         if (list != NULL) {
 463                 func = perl_func_sv_inc(func, perl_get_package());
 464                 perl_signal_remove_list(list, func);
 465                 SvREFCNT_dec(func);
 466         }
 467 }
 468
 469 void perl_command_bind_to(const char *cmd, const char *category,
 470                           SV *func, int priority)
 471 {
 472         char *signal;
 473
 474         signal = g_strconcat("command ", cmd, NULL);
 475         perl_signal_add_full_int(signal, func, priority, TRUE, category);
 476         g_free(signal);
 477 }
 478
 479 void perl_command_runsub(const char *cmd, const char *data,
 480                          SERVER_REC *server, WI_ITEM_REC *item)
 481 {
 482         command_runsub(cmd, data, server, item);
 483 }
 484
 485 void perl_command_unbind(const char *cmd, SV *func)
 486 {
 487         char *signal;
 488
 489         /* perl_signal_remove() calls command_unbind() */
 490         signal = g_strconcat("command ", cmd, NULL);
 491         perl_signal_remove(signal, func);
 492         g_free(signal);
 493 }
 494
 495 static int signal_destroy_hash(void *key, GSList **list, PERL_SCRIPT_REC *script)
 496 {
 497         GSList *tmp, *next;
 498
 499         for (tmp = *list; tmp != NULL; tmp = next) {
 500                 PERL_SIGNAL_REC *rec = tmp->data;
 501
 502                 next = tmp->next;
 503                 if (script == NULL || rec->script == script) {
 504                         *list = g_slist_remove(*list, rec);
 505                         perl_signal_destroy(rec);
 506                 }
 507         }
 508
 509         if (*list != NULL)
 510                 return FALSE;
 511
 512         g_free(list);
 513         return TRUE;
 514 }
 515
 516 /* destroy all signals used by script */
 517 void perl_signal_remove_script(PERL_SCRIPT_REC *script)
 518 {
 519         g_hash_table_foreach_remove(signals, (GHRFunc) signal_destroy_hash,
 520                                     script);
 521 }
 522
 523 void perl_signals_start(void)
 524 {
 525         signals = g_hash_table_new(NULL, NULL);
 526 }
 527
 528 void perl_signals_stop(void)
 529 {
 530         g_hash_table_foreach(signals, (GHFunc) signal_destroy_hash, NULL);
 531         g_hash_table_destroy(signals);
 532         signals = NULL;
 533 }
 534
 535 static void register_signal_rec(PERL_SIGNAL_ARGS_REC *rec)
 536 {
 537         if (rec->signal[strlen(rec->signal)-1] == ' ') {
 538                 perl_signal_args_partial =
 539                         g_slist_append(perl_signal_args_partial, rec);
 540         } else {
 541                 int signal_id = signal_get_uniq_id(rec->signal);
 542                 g_hash_table_insert(perl_signal_args_hash,
 543                                     GINT_TO_POINTER(signal_id), rec);
 544         }
 545 }
 546
 547 void perl_signal_register(const char *signal, const char **args)
 548 {
 549         PERL_SIGNAL_ARGS_REC *rec;
 550         int i;
 551
 552         if (perl_signal_args_find(signal_get_uniq_id(signal)) != NULL)
 553                 return;
 554
 555         rec = g_new0(PERL_SIGNAL_ARGS_REC, 1);
 556         for (i = 0; i < 6 && args[i] != NULL; i++)
 557                 rec->args[i] = g_strdup(args[i]);
 558         rec->dynamic = TRUE;
 559         rec->signal = g_strdup(signal);
 560         register_signal_rec(rec);
 561 }
 562
 563 void perl_signals_init(void)
 564 {
 565         int n;
 566
 567         perl_signal_args_hash = g_hash_table_new((GHashFunc) g_direct_hash,
 568                                                  (GCompareFunc) g_direct_equal);
 569         perl_signal_args_partial = NULL;
 570
 571         for (n = 0; perl_signal_args[n].signal != NULL; n++)
 572                 register_signal_rec(&perl_signal_args[n]);
 573 }
 574
 575 static void signal_args_free(PERL_SIGNAL_ARGS_REC *rec)
 576 {
 577         int i;
 578
 579         if (!rec->dynamic)
 580                 return;
 581
 582         for (i = 0; i < 6 && rec->args[i] != NULL; i++)
 583                 g_free(rec->args[i]);
 584         g_free(rec->signal);
 585         g_free(rec);
 586 }
 587
 588 static void signal_args_hash_free(void *key, PERL_SIGNAL_ARGS_REC *rec)
 589 {
 590         signal_args_free(rec);
 591 }
 592
 593 void perl_signals_deinit(void)
 594 {
 595         g_slist_foreach(perl_signal_args_partial,
 596                         (GFunc) signal_args_free, NULL);
 597         g_slist_free(perl_signal_args_partial);
 598
 599         g_hash_table_foreach(perl_signal_args_hash,
 600                              (GHFunc) signal_args_hash_free, NULL);
 601         g_hash_table_destroy(perl_signal_args_hash);
 602 }