1 /*---------------------------------------------------------------------------
2 * The runtime module.
3 *
4 *---------------------------------------------------------------------------
5 * simulate is a collection of structures and functions which provide the
6 * basic runtime functionality:
7 *
8 * - the object list
9 * - loading, cloning, and destructing objects
10 * - the runtime context stack
11 * - error handling
12 * - function callbacks
13 * - management of the driver hooks
14 * - handling of object inventories and shadows.
15 *
16 * The data structures, especially the runtime stack, are described where
17 * they are defined.
18 *---------------------------------------------------------------------------
19 */
20
21 #include "driver.h"
22 #include "typedefs.h"
23
24 #include "my-alloca.h"
25 #include <fcntl.h>
26 #include <setjmp.h>
27 #include <stdio.h>
28 #include <stdarg.h>
29 #include <sys/types.h>
30 #include <sys/stat.h>
31 #include <signal.h>
32
33 /*-------------------------------------------------------------------------*/
34
35 #include "simulate.h"
36
37 #include "actions.h"
38 #include "array.h"
39 #include "backend.h"
40 #include "call_out.h"
41 #include "closure.h"
42 #include "comm.h"
43 #include "ed.h"
44 #include "filestat.h"
45 #include "gcollect.h"
46 #include "heartbeat.h"
47 #include "lex.h"
48 #include "main.h"
49 #include "mapping.h"
50 #include "mempools.h"
51 #include "mregex.h"
52 #include "mstrings.h"
53 #include "object.h"
54 #include "otable.h"
55 #ifdef USE_TLS
56 #include "pkg-tls.h"
57 #endif
58 #ifdef USE_SQLITE
59 #include "pkg-sqlite.h"
60 #endif
61 #include "prolang.h"
62 #include "sent.h"
63 #include "simul_efun.h"
64 #include "stdstrings.h"
65 #include "strfuns.h"
66 #ifdef USE_STRUCTS
67 #include "structs.h"
68 #endif
69 #include "swap.h"
70 #include "svalue.h"
71 #include "wiz_list.h"
72 #include "xalloc.h"
73
74 #include "i-eval_cost.h"
75
76 #include "../mudlib/sys/debug_info.h"
77 #include "../mudlib/sys/driver_hook.h"
78 #include "../mudlib/sys/files.h"
79 #include "../mudlib/sys/regexp.h"
80 #include "../mudlib/sys/rtlimits.h"
81
82 /*-------------------------------------------------------------------------*/
83
84 /* --- struct limits_context_s: last runtime limits context ---
85 *
86 * This structure saves the runtime limits on the runtime context stack.
87 * It is also used as a temporary when parsing limit specifications.
88 */
89
90 struct limits_context_s
91 {
92 rt_context_t rt; /* the rt_context superclass */
93 size_t max_array; /* max array size */
94 size_t max_mapping; /* max mapping size in values */
95 size_t max_map_keys; /* max mapping size in entries */
96 int32 max_eval; /* max eval cost */
97 int32 max_byte; /* max byte xfer */
98 int32 max_file; /* max file xfer */
99 int32 max_callouts; /* max callouts */
100 int32 use_cost; /* the desired cost of the evaluation */
101 int32 eval_cost; /* the then-current eval costs used */
102 };
103
104
105 /* --- struct give_uid_error_context ---
106 *
107 * A structure of this type is pushed as error handler on the
108 * interpreter stack while a newly created object is given its uids.
109 */
110
111 struct give_uid_error_context
112 {
113 svalue_t head; /* A T_ERROR_HANDLER with this struct as arg */
114 object_t *new_object; /* The object under processing */
115 };
116
117
118 /* --- struct namechain ---
119 *
120 * This structure is used by load_object() to build the current inheritence
121 * chain in the frames on the stack. The information is used to generate
122 * proper error messages.
123 */
124
125 typedef struct namechain_s
126 {
127 struct namechain_s * prev; /* Pointer to the previous element, or NULL */
128 char * name; /* Pointer to the name to load */
129 } namechain_t;
130
131 /*-------------------------------------------------------------------------*/
132
133 /* The runtime context stack.
134 *
135 * Runtime context informations are maintained in a linked list, with
136 * cur_context pointing to the most recently pushed context.
137 * From there, the links go back through the less recently pushed contexts
138 * and end with the toplevel_context.
139 */
140
141 struct error_recovery_info toplevel_context
142 = {
143 { NULL,
144 ERROR_RECOVERY_NONE
145 }
146 };
147
148 rt_context_t * rt_context
149 = (rt_context_t *)&toplevel_context.rt;
150
151 /*-------------------------------------------------------------------------*/
152
153 static p_int alloc_shadow_sent = 0;
154 /* Statistic: how many shadow sentences have been allocated.
155 */
156
157 object_t *obj_list = NULL;
158 /* Head of the list of all objects. The reference by this list
159 * is counted.
160 * The first object in the list has its .prev_all member cleared.
161 */
162
163 object_t *obj_list_end = NULL;
164 /* Last object in obj_list. This object also has its .next_all member
165 * cleared.
166 */
167
168 #ifdef CHECK_OBJECT_REF
169 object_shadow_t * destructed_obj_shadows = NULL;
170 object_shadow_t * newly_destructed_obj_shadows = NULL;
171 #endif /* CHECK_OBJECT_REF */
172
173 object_t *destructed_objs = NULL;
174 /* List holding destructed but not yet fully dereferenced objects.
175 * Only the name and the program pointer are guarantueed to be valid.
176 * The reference by this list is counted.
177 * Objects with only the list reference left are finally freed by
178 * the function remove_destructed_objects() called from the backend.
179 #ifdef GC_SUPPORT
180 * They are also freed by a GC.
181 #endif
182 * TODO: If this turns out to be not soon enough, modify the free_object()
183 * TODO:: call to recognize the destructed+one-ref-left situation.
184 *
185 * This list is not exactly necessary, as destructed objects would be
186 * deallcoated automatically once the last reference is gone, but it
187 * helps mud admins to figure out where all the memory goes.
188 */
189
190 long num_destructed = 0;
191 /* Statistics: Number of objects in the destructed_objs list.
192 */
193
194 object_t *newly_destructed_objs = NULL;
195 /* List holding objects destructed in this execution thread.
196 * They are no longer part of the obj_list, but since programs may still
197 * be executing in them, the aren't fully destructed yet.
198 */
199
200 long num_newly_destructed = 0;
201 /* Statistics: Number of objects in the newly_destructed_objs list.
202 */
203
204 object_t *master_ob = NULL;
205 /* The master object.
206 */
207
208 object_t *current_object = NULL;
209 /* The object interpreting a function.
210 */
211
212 object_t *current_interactive;
213 /* The user who caused this execution.
214 */
215
216 object_t *previous_ob;
217 /* The previous object which called the current_object.
218 */
219
220 svalue_t driver_hook[NUM_DRIVER_HOOKS];
221 /* The table with all driver hooks.
222 */
223
224 Bool game_is_being_shut_down = MY_FALSE;
225 /* TRUE if a shutdown was requested resp. is in progress.
226 */
227
228 Bool master_will_be_updated = MY_FALSE;
229 /* TRUE if a master-update was requested.
230 */
231
232 static Bool in_fatal = MY_FALSE;
233 /* TRUE if fatal() is being processed.
234 */
235
236 int num_error = 0;
237 /* Number of recursive calls to errorf().
238 */
239
240 int num_warning = 0;
241 /* Number of recursive calls to warnf().
242 */
243
244 static char emsg_buf[ERROR_BUF_LEN];
245 /* The buffer for the error message to be created.
246 */
247
248 string_t *current_error;
249 string_t *current_error_file;
250 string_t *current_error_object_name;
251 mp_int current_error_line_number;
252 /* When an error occured during secure_apply(), these four
253 * variables receive allocated copies (resp. counted refs) of
254 * the error message, the name of the active program and object, and the
255 * line number in the program.
256 */
257
258 vector_t *uncaught_error_trace = NULL;
259 vector_t *current_error_trace = NULL;
260 /* When an error occured, these variables hold the call chain in the
261 * format used by efun debug_info() for evaluation by the mudlib.
262 * The variables are kept until the next error, or until a GC.
263 * 'uncaught_error_trace': the most recent uncaught error
264 * 'current_error_trace': the most recent error, caught or uncaught.
265 */
266
267 /* --- Runtime limits --- */
268
269 /* Each of these limits comes as pair: one def_... value which holds the
270 * limit set at startup or with the set_limits() efun, and the max_...
271 * value which holds the limit currently in effect. Before every execution,
272 * max_... are initialised from def_... with the RESET_LIMITS macro.
273 *
274 * A limit of 0 usually means 'no limit'.
275 */
276
277 size_t def_array_size = MAX_ARRAY_SIZE;
278 size_t max_array_size = MAX_ARRAY_SIZE;
279 /* If != 0: the max. number of elements in an array.
280 */
281
282 size_t def_mapping_size = MAX_MAPPING_SIZE;
283 size_t max_mapping_size = MAX_MAPPING_SIZE;
284 /* If != 0: the max. number of elements in a mapping.
285 */
286
287 size_t def_mapping_keys = MAX_MAPPING_KEYS;
288 size_t max_mapping_keys = MAX_MAPPING_KEYS;
289 /* If != 0: the max. number of entries in a mapping.
290 */
291
292 int32 def_eval_cost = MAX_COST;
293 int32 max_eval_cost = MAX_COST;
294 /* The max eval cost available for one execution thread. Stored as negative
295 * value for easier initialisation (see eval_cost).
296 * CLEAR_EVAL_COST uses this value to re-initialize (assigned_)eval_cost.
297 */
298
299 int32 use_eval_cost = DEF_USE_EVAL_COST;
300 /* How to account for the cost of the current evaluation.
301 * > 0: the cost to use regardless of actual cost.
302 * == 0: use the actual cost if the max_eval limit was less than the
303 * default; use 10 ticks if it was more.
304 * < 0: use -val% of the actual cost
305 */
306
307 int32 def_byte_xfer = MAX_BYTE_TRANSFER;
308 int32 max_byte_xfer = MAX_BYTE_TRANSFER;
309 /* Maximum number of bytes to read/write in one read/write_bytes() call.
310 * If 0, it is unlimited.
311 */
312
313 int32 def_file_xfer = READ_FILE_MAX_SIZE;
314 int32 max_file_xfer = READ_FILE_MAX_SIZE;
315 /* Maximum number of bytes to read/write in one read/write_file() call.
316 */
317
318 int32 def_callouts = MAX_CALLOUTS;
319 int32 max_callouts = MAX_CALLOUTS;
320 /* If != 0: the max. number of callouts at one time.
321 */
322
323 /*-------------------------------------------------------------------------*/
324 /* Forward declarations */
325
326 static void free_shadow_sent (shadow_t *p);
327
328 /*-------------------------------------------------------------------------*/
329 Bool
catch_instruction(int flags,uint offset,volatile svalue_t ** volatile i_sp,bytecode_p i_pc,svalue_t * i_fp,int32 reserve_cost,svalue_t * i_context)330 catch_instruction ( int flags, uint offset
331 , volatile svalue_t ** volatile i_sp
332 , bytecode_p i_pc, svalue_t * i_fp
333 , int32 reserve_cost
334 #ifdef USE_NEW_INLINES
335 , svalue_t * i_context
336 #endif /* USE_NEW_INLINES */
337 )
338
339 /* Implement the F_CATCH instruction.
340 *
341 * At the time of call, all important locals from eval_instruction() are
342 * have been stored in their global locations.
343 *
344 * Result is TRUE on a normal exit (error or not), and FALSE if the
345 * guarded code terminated with a 'return' itself;
346 *
347 * Hard experience showed that it is advantageous to have setjmp()
348 * to have its own stackframe, and call the longjmp() from a deeper
349 * frame. Additionally it prevents over-optimistic optimizers from
350 * removing vital reloads of possibly clobbered local variables after
351 * the setjmp().
352 */
353
354 {
355 #define INTER_SP ((svalue_t *)(*i_sp))
356
357 Bool rc;
358 volatile Bool old_out_of_memory = out_of_memory;
359
360 bytecode_p new_pc; /* Address of first instruction after the catch() */
361
362 /* Compute address of next instruction after the CATCH statement.
363 */
364 new_pc = i_pc + offset;
365
366 /* 'Fake' a subroutine call from <new_pc>
367 */
368 #ifdef USE_NEW_INLINES
369 push_control_stack(INTER_SP, new_pc, i_fp, i_context);
370 #else
371 push_control_stack(INTER_SP, new_pc, i_fp);
372 #endif /* USE_NEW_INLINES */
373 csp->ob = current_object;
374 csp->extern_call = MY_FALSE;
375 csp->catch_call = MY_TRUE;
376 #ifndef DEBUG
377 csp->num_local_variables = 0; /* No extra variables */
378 #else
379 csp->num_local_variables = (csp-1)->num_local_variables;
380 /* TODO: Marion added this, but why? For 'expected_stack'? */
381 #endif
382 csp->funstart = csp[-1].funstart;
383
384 /* Save some globals on the error stack that must be restored
385 * separately after a longjmp, then set the jump.
386 */
387 if ( setjmp( push_error_context(INTER_SP, flags)->text ) )
388 {
389 /* A throw() or error occured. We have to restore the
390 * control and error stack manually here.
391 *
392 * The error value to return will be stored in
393 * the global <catch_value>.
394 */
395 svalue_t *sp;
396 svalue_t catch_value;
397
398 /* Remove the catch context and get the old stackpointer setting */
399 sp = pull_error_context(INTER_SP, &catch_value);
400
401 /* beware of errors after set_this_object() */
402 current_object = csp->ob;
403
404 /* catch() faked a subroutine call internally, which has to be
405 * undone again. This will also set the pc to the proper
406 * continuation address.
407 */
408 pop_control_stack();
409
410 /* Push the catch return value */
411 *(++sp) = catch_value;
412
413 *i_sp = (volatile svalue_t *)sp;
414
415 /* Restore the old eval costs */
416 eval_cost -= reserve_cost;
417 assigned_eval_cost -= reserve_cost;
418
419 /* If we ran out of memory, throw a new error */
420 if (!old_out_of_memory && out_of_memory)
421 {
422 errorf("(catch) Out of memory detected.\n");
423 }
424
425 rc = MY_TRUE;
426 }
427 else
428 {
429
430 /* Increase the eval_cost for the duration of the catch so that
431 * there is enough time left to handle an eval-too-big error.
432 * Do this before the check as the error handling will subtract
433 * the reserve again.
434 */
435 eval_cost += reserve_cost;
436 assigned_eval_cost += reserve_cost;
437
438 if (max_eval_cost && eval_cost >= max_eval_cost)
439 {
440 errorf("Not enough eval time left for catch(): required %"PRId32
441 ", available %"PRId32"\n", reserve_cost,
442 (max_eval_cost - eval_cost + reserve_cost)
443 );
444 /* NOTREACHED */
445 return MY_TRUE;
446 }
447
448 /* Recursively call the interpreter */
449 rc = eval_instruction(i_pc, INTER_SP);
450
451 if (rc)
452 {
453 /* Get rid of the code result */
454 pop_stack();
455
456 /* Restore the old execution context */
457 pop_control_stack();
458 pop_error_context();
459
460 /* Since no error happened, push 0 onto the stack */
461 push_number(inter_sp, 0);
462 }
463
464 eval_cost -= reserve_cost;
465 assigned_eval_cost -= reserve_cost;
466 }
467
468 return rc;
469 } /* catch_instruction() */
470
471 /*-------------------------------------------------------------------------*/
472 static INLINE void
save_limits_context(struct limits_context_s * context)473 save_limits_context (struct limits_context_s * context)
474
475 /* Save the current limits context into <context> (but don't put it
476 * onto the context stack).
477 */
478
479 {
480 context->rt.type = LIMITS_CONTEXT;
481 context->max_array = max_array_size;
482 context->max_callouts = max_callouts;
483 context->max_mapping = max_mapping_size;
484 context->max_map_keys = max_mapping_keys;
485 context->max_eval = max_eval_cost;
486 context->eval_cost = eval_cost;
487 context->max_byte = max_byte_xfer;
488 context->max_file = max_file_xfer;
489 context->use_cost = use_eval_cost;
490 } /* save_limits_context() */
491
492 /*-------------------------------------------------------------------------*/
493 static INLINE void
restore_limits_context(struct limits_context_s * context)494 restore_limits_context (struct limits_context_s * context)
495
496 /* Restore the last runtime limits from <context>.
497 *
498 * Restoring max_eval_cost is a bit tricky since eval_cost
499 * itself might be a bit too high for the restored limit, but
500 * avoiding a 'eval-cost too high' was the point of the exercise
501 * in the first place. Therefore, if we ran under a less limited
502 * eval-cost limit, we fake an effective cost of 10 ticks.
503 */
504
505 {
506 assign_eval_cost();
507 if (use_eval_cost == 0)
508 {
509 if (!max_eval_cost || max_eval_cost > context->max_eval)
510 {
511 assigned_eval_cost = eval_cost = context->eval_cost+10;
512 }
513 }
514 else if (use_eval_cost > 0)
515 {
516 int32 elapsed_cost = eval_cost - context->eval_cost;
517
518 if (elapsed_cost > use_eval_cost)
519 assigned_eval_cost = eval_cost = use_eval_cost + context->eval_cost;
520 assigned_eval_cost = eval_cost;
521 }
522 else /* (use_eval_cost < 0) */
523 {
524 int32 elapsed_cost = eval_cost - context->eval_cost;
525 int32 whole_fact = (-use_eval_cost) / 100;
526 int32 fract_fact = (-use_eval_cost) % 100;
527 eval_cost = context->eval_cost
528 + elapsed_cost * whole_fact
529 + elapsed_cost * fract_fact / 100;
530 assigned_eval_cost = eval_cost;
531 }
532 max_array_size = context->max_array;
533 max_mapping_size = context->max_mapping;
534 max_mapping_keys = context->max_map_keys;
535 max_callouts = context->max_callouts;
536 max_eval_cost = context->max_eval;
537 max_byte_xfer = context->max_byte;
538 max_file_xfer = context->max_file;
539 use_eval_cost = context->use_cost;
540 } /* restore_limits_context() */
541
542 /*-------------------------------------------------------------------------*/
543 static void
unroll_context_stack(void)544 unroll_context_stack (void)
545
546 /* Remove entries from the rt_context stack until the last entry
547 * is an ERROR_RECOVERY context.
548 */
549
550 {
551 while (!ERROR_RECOVERY_CONTEXT(rt_context->type))
552 {
553 rt_context_t * context = rt_context;
554
555 rt_context = rt_context->last;
556 switch(context->type)
557 {
558 case COMMAND_CONTEXT:
559 restore_command_context(context);
560 break;
561
562 case LIMITS_CONTEXT:
563 restore_limits_context((struct limits_context_s *)context);
564 break;
565
566 default:
567 fatal("Unimplemented context type %d.\n", context->type);
568 /* NOTREACHED */
569 }
570 }
571 } /* unroll_context_stack() */
572
573 /*-------------------------------------------------------------------------*/
574 static INLINE void dump_core(void) NORETURN;
575
576 static INLINE void
dump_core(void)577 dump_core(void)
578
579 /* A wrapper around abort() to make sure that we indeed dump a core.
580 */
581
582 {
583 /* we want a core dump, and abort() seems to fail for linux and sun */
584 (void)signal(SIGFPE, SIG_DFL);
585 {
586 int a = 0; /* avoids a pesky diagnostic */
587 *((char*)0) = 0/a;
588 *((char*)fatal) = 0/a;
589 }
590 abort();
591 } /* dump_core() */
592
593 /*-------------------------------------------------------------------------*/
594 void
fatal(const char * fmt,...)595 fatal (const char *fmt, ...)
596
597 /* A fatal error occured. Generate a message from printf-style <fmt>, including
598 * a timestamp, dump the backtrace and abort.
599 */
600
601 {
602 va_list va;
603 char *ts;
604
605 /* Prevent double fatal. */
606 if (in_fatal)
607 {
608 dump_core();
609 }
610 in_fatal = MY_TRUE;
611
612 ts = time_stamp();
613
614 va_start(va, fmt);
615
616 fflush(stdout);
617 fprintf(stderr, "%s ", ts);
618 vfprintf(stderr, fmt, va);
619 fflush(stderr);
620 if (current_object)
621 fprintf(stderr, "%s Current object was %s\n"
622 , ts, current_object->name
623 ? get_txt(current_object->name) : "<null>");
624 debug_message("%s ", ts);
625 vdebug_message(fmt, va);
626 if (current_object)
627 debug_message("%s Current object was %s\n"
628 , ts, current_object->name
629 ? get_txt(current_object->name) : "<null>");
630 debug_message("%s Dump of the call chain:\n", ts);
631 (void)dump_trace(MY_TRUE, NULL);
632 printf("%s LDMud aborting on fatal error.\n", time_stamp());
633 fflush(stdout);
634
635 sleep(1); /* let stdout settle down... abort can ignore the buffer... */
636
637 va_end(va);
638
639 /* Before shutting down, try to inform the game about it */
640 push_ref_string(inter_sp, STR_FATAL_ERROR);
641 callback_master(STR_SHUTDOWN, 1);
642
643 /* Mandatory cleanups */
644 #ifdef USE_TLS
645 tls_global_deinit();
646 #endif
647
648 /* Dump core and exit */
649 dump_core();
650 } /* fatal() */
651
652 /*-------------------------------------------------------------------------*/
653 char *
limit_error_format(char * fixed_fmt,size_t fixed_fmt_len,const char * fmt)654 limit_error_format (char *fixed_fmt, size_t fixed_fmt_len, const char *fmt)
655
656 /* Safety function for error messages: in the error message <fmt>
657 * every '%s' spec is changed to '%.200s' to avoid buffer overflows.
658 * The modified format string is stored in <fixed_fmt> (a caller provided
659 * buffer of size <fixed_fmd_len>) which is also returned as result.
660 */
661
662 {
663 char *ffptr;
664
665 ffptr = fixed_fmt;
666 while (*fmt && ffptr < fixed_fmt + fixed_fmt_len-1)
667 {
668 if ((*ffptr++=*fmt++)=='%')
669 {
670 if (*fmt == 's')
671 {
672 *ffptr++ = '.';
673 *ffptr++ = '2';
674 *ffptr++ = '0';
675 *ffptr++ = '0';
676 }
677 }
678 }
679
680 if (*fmt)
681 {
682 /* We reached the end of the fixed_fmt buffer before
683 * the <fmt> string was complete: mark this error message
684 * as truncated.
685 * ffptr points to the last byte in the <fixed_fmt> buffer.
686 */
687 ffptr[-3] = '.';
688 ffptr[-2] = '.';
689 ffptr[-1] = '.';
690 }
691
692 *ffptr = '\0';
693 return fixed_fmt;
694 } /* limit_error_format() */
695
696 /*-------------------------------------------------------------------------*/
697 void
errorf(const char * fmt,...)698 errorf (const char *fmt, ...)
699
700 /* A system runtime error occured: generate a message from printf-style
701 * <fmt> with a timestamp, and handle it.
702 * If the error is caught, just dump the trace on stderr, and jump to the
703 * error handler, otherwise call the mudlib's error functions (this may cause
704 * recursive calls to errorf()) and jump back to wherever the current error
705 * recovery context points to.
706 *
707 * The runtime context stack is unrolled as far as necessary.
708 * TODO: Add a perrorf(<prefmt>, <postfmt>,...) function which translates the
709 * TODO:: errno into a string and calls errorf(<prefmt><errmsg><postfmt>, ...).
710 */
711
712 {
713 rt_context_t *rt;
714 string_t *object_name = NULL;
715 char *ts;
716 svalue_t *svp;
717 Bool error_caught;
718 /* TRUE: User catches this error.
719 */
720 Bool published_catch;
721 /* TRUE: this is a catch which wants runtime_error to be called
722 */
723 Bool do_save_error;
724 string_t *file; /* program name */
725 string_t *malloced_error; /* copy of emsg_buf+1 */
726 string_t *malloced_file = NULL; /* copy of program name */
727 string_t *malloced_name = NULL; /* copy of the object name */
728 object_t *curobj = NULL; /* Verified current object */
729 char fixed_fmt[ERROR_FMT_LEN];
730 /* Note: When changing this buffer, also change the HEAP_STACK_GAP
731 * limit in xalloc.c!
732 */
733 mp_int line_number = 0;
734 va_list va;
735
736 /* Errors during the fatal() processing will abort the process
737 * immediately.
738 */
739 if (in_fatal)
740 fatal("Error during fatal().");
741
742 ts = time_stamp();
743
744 /* Find the last error recovery context, but do not yet unroll
745 * the stack: the current command context might be needed
746 * in the runtime error apply.
747 */
748 for ( rt = rt_context
749 ; !ERROR_RECOVERY_CONTEXT(rt->type)
750 ; rt = rt->last) NOOP;
751
752 va_start(va, fmt);
753
754 /* Make fmt sane */
755 fmt = limit_error_format(fixed_fmt, sizeof(fixed_fmt), fmt);
756
757 /* Check the current object */
758 curobj = NULL;
759 if (current_object != NULL
760 && current_object != &dummy_current_object_for_loads)
761 curobj = current_object;
762
763 if (curobj)
764 assign_eval_cost();
765
766 /* We allow recursive errors only from "sensitive" environments.
767 */
768 if (num_error && rt->type <= ERROR_RECOVERY_APPLY)
769 {
770 static char *times_word[] = {
771 "",
772 "Double",
773 "Triple",
774 "Quadruple",
775 };
776 debug_message("%s %s fault, last error was: %s"
777 , ts, times_word[num_error]
778 , emsg_buf + 1
779 );
780 }
781
782 /* Generate the error message */
783 vsprintf(emsg_buf+1, fmt, va);
784 va_end(va);
785
786 emsg_buf[0] = '*'; /* all system errors get a * at the start */
787
788 error_caught = MY_FALSE;
789 published_catch = MY_FALSE;
790
791 if (rt->type >= ERROR_RECOVERY_CATCH)
792 {
793 /* User catches this error */
794
795 error_caught = MY_TRUE;
796
797 /* Try to copy the error message into the catch value.
798 * If we run out of memory here, we won't execute the catch.
799 */
800 {
801 string_t * str = new_mstring(emsg_buf);
802
803 if (NULL != str)
804 {
805 svalue_t stmp;
806
807 put_string(&stmp, str);
808 transfer_error_message(&stmp, rt);
809 }
810 else
811 {
812 error_caught = MY_FALSE;
813
814 /* Unroll the context stack even further until the
815 * previous non-catch error recovery frame.
816 */
817 for (
818 ; !ERROR_RECOVERY_CONTEXT(rt->type)
819 && rt->type >= ERROR_RECOVERY_CATCH
820 ; rt = rt->last) NOOP;
821 }
822 }
823 }
824
825 if (error_caught)
826 {
827 struct error_recovery_info * eri = (struct error_recovery_info *)rt;
828
829 published_catch = (eri->flags & CATCH_FLAG_PUBLISH);
830
831 if (!out_of_memory)
832 {
833 if (!(eri->flags & CATCH_FLAG_NOLOG))
834 {
835 /* Even though caught, dump the backtrace - it makes mudlib
836 * debugging much easier.
837 */
838 debug_message("%s Caught error: %s", ts, emsg_buf + 1);
839 printf("%s Caught error: %s", ts, emsg_buf + 1);
840 if (current_error_trace)
841 {
842 free_array(current_error_trace);
843 current_error_trace = NULL;
844 }
845 object_name = dump_trace(MY_FALSE, ¤t_error_trace);
846 debug_message("%s ... execution continues.\n", ts);
847 printf("%s ... execution continues.\n", ts);
848 }
849 else
850 {
851 /* No dump of the backtrace into the log, but we want it
852 * available for debug_info().
853 */
854 if (current_error_trace)
855 {
856 free_array(current_error_trace);
857 current_error_trace = NULL;
858 }
859 object_name = collect_trace(NULL, ¤t_error_trace);
860 }
861 }
862 else /* We're running low on memory. */
863 {
864 if (current_error_trace)
865 {
866 free_array(current_error_trace);
867 current_error_trace = NULL;
868 }
869 object_name = STR_UNKNOWN_OBJECT;
870 }
871
872 if (!published_catch)
873 {
874 unroll_context_stack();
875 longjmp(((struct error_recovery_info *)rt_context)->con.text, 1);
876 fatal("Catch() longjump failed");
877 }
878 }
879
880 /* Error not caught by the program, or catch() requests the
881 * runtime_error() is to be called.
882 */
883
884 num_error++;
885 if (num_error > 3)
886 fatal("Too many simultaneous errors.\n");
887
888 debug_message("%s ", ts);
889 debug_message("%s", emsg_buf+1);
890
891 do_save_error = MY_FALSE;
892
893 /* Get a copy of the error message */
894 malloced_error = new_mstring(emsg_buf+1);
895
896 /* If we have a current_object, determine the program location
897 * of the fault.
898 */
899 if (curobj)
900 {
901 line_number = get_line_number_if_any(&file);
902 debug_message("%s program: %s, object: %s line %"PRIdMPINT"\n"
903 , ts, get_txt(file), get_txt(curobj->name)
904 , line_number);
905 if (current_prog && num_error < 3)
906 {
907 do_save_error = MY_TRUE;
908 }
909
910 malloced_file = file; /* Adopt reference */
911 malloced_name = ref_mstring(curobj->name);
912 }
913
914 /* On a triple error, duplicate the error messages so far on stdout */
915
916 if (num_error == 3)
917 {
918 /* Error context is secure_apply() */
919
920 printf("%s error in function call: %s", ts, emsg_buf+1);
921 if (curobj)
922 {
923 printf("%s program: %s, object: %s line %"PRIdMPINT"\n"
924 , ts, get_txt(file), get_txt(curobj->name)
925 , line_number
926 );
927 }
928 }
929
930 /* Dump the backtrace (unless already done) */
931 if (!published_catch)
932 {
933 if (uncaught_error_trace)
934 {
935 free_array(uncaught_error_trace);
936 uncaught_error_trace = NULL;
937 }
938 if (current_error_trace)
939 {
940 free_array(current_error_trace);
941 current_error_trace = NULL;
942 }
943
944 object_name = dump_trace(num_error == 3, ¤t_error_trace);
945 if (!published_catch)
946 uncaught_error_trace = ref_array(current_error_trace);
947 fflush(stdout);
948 }
949
950 if (rt->type == ERROR_RECOVERY_APPLY)
951 {
952 /* Error context is secure_apply() */
953
954 current_error = malloced_error;
955 current_error_file = malloced_file;
956 current_error_object_name = malloced_name;
957 current_error_line_number = line_number;
958
959 if (out_of_memory)
960 {
961 if (malloced_error)
962 {
963 free_mstring(malloced_error);
964 malloced_error = NULL;
965 }
966 if (malloced_file)
967 {
968 free_mstring(malloced_file);
969 malloced_file = NULL;
970 }
971 if (malloced_name)
972 {
973 free_mstring(malloced_name);
974 malloced_name = NULL;
975 }
976 if (current_error_trace)
977 {
978 free_array(current_error_trace);
979 current_error_trace = NULL;
980 }
981 if (uncaught_error_trace)
982 {
983 free_array(uncaught_error_trace);
984 uncaught_error_trace = NULL;
985 }
986 }
987 unroll_context_stack();
988 longjmp(((struct error_recovery_info *)rt_context)->con.text, 1);
989 }
990
991 /* If the error is not caught at all, the stack must be brought in a
992 * usable state. After the call to reset_machine(), all arguments to
993 * errorf() are invalid, and may not be used any more. The reason is that
994 * some strings may have been on the stack machine stack, and have been
995 * deallocated.
996 */
997
998 if (!published_catch)
999 reset_machine(MY_FALSE);
1000
1001 if (do_save_error)
1002 {
1003 save_error(emsg_buf, get_txt(file), line_number);
1004 }
1005
1006 if (object_name)
1007 {
1008 /* Error occured in a heart_beat() function */
1009
1010 object_t *ob;
1011
1012 ob = find_object(object_name);
1013 if (!ob)
1014 {
1015 if (command_giver && num_error < 2)
1016 add_message("error when executing program in destroyed object %s\n",
1017 get_txt(object_name));
1018 debug_message("%s error when executing program in destroyed object %s\n"
1019 , ts, get_txt(object_name));
1020 }
1021 }
1022
1023 if (num_error == 3)
1024 {
1025 debug_message("%s Master failure: %s", ts, emsg_buf+1);
1026 printf("%s Master failure: %s", ts, emsg_buf+1);
1027 }
1028 else if (!out_of_memory)
1029 {
1030 /* We have memory: call master:runtime(), and maybe
1031 * also master:heart_beat_error().
1032 */
1033
1034 int a;
1035 object_t *save_cmd;
1036 object_t *culprit = NULL;
1037
1038
1039 if (!published_catch)
1040 {
1041 CLEAR_EVAL_COST;
1042 RESET_LIMITS;
1043 }
1044
1045 push_ref_string(inter_sp, malloced_error);
1046 a = 1;
1047 if (curobj)
1048 {
1049 push_ref_string(inter_sp, malloced_file);
1050 push_ref_string(inter_sp, malloced_name);
1051 push_number(inter_sp, line_number);
1052 a += 3;
1053 }
1054
1055 if (current_heart_beat)
1056 {
1057 /* Heartbeat error: turn off the heartbeat in the object
1058 * and also pass it to RUNTIME_ERROR.
1059 */
1060
1061 culprit = current_heart_beat;
1062 current_heart_beat = NULL;
1063 set_heart_beat(culprit, MY_FALSE);
1064 debug_message("%s Heart beat in %s turned off.\n"
1065 , time_stamp(), get_txt(culprit->name));
1066 push_ref_valid_object(inter_sp, culprit, "heartbeat error");
1067 a++;
1068 }
1069 else
1070 {
1071 if (!curobj)
1072 {
1073 /* Push dummy values to keep the argument order correct */
1074 push_number(inter_sp, 0);
1075 push_number(inter_sp, 0);
1076 push_number(inter_sp, 0);
1077 a += 3;
1078 }
1079
1080 /* Normal error: push -1 instead of a culprit. */
1081 push_number(inter_sp, -1);
1082 a++;
1083 }
1084
1085 push_number(inter_sp, error_caught ? 1 : 0);
1086 a++;
1087
1088 save_cmd = command_giver;
1089 apply_master(STR_RUNTIME, a);
1090 command_giver = save_cmd;
1091
1092 if (culprit)
1093 {
1094 /* TODO: Merge heart_beat_error() in to runtime_error() */
1095
1096 /* Heartbeat error: call the master to log it
1097 * and to see if the heartbeat shall be turned
1098 * back on for this object.
1099 */
1100
1101 push_ref_valid_object(inter_sp, culprit, "runtime_error");
1102 push_ref_string(inter_sp, malloced_error);
1103 a = 2;
1104 if (curobj)
1105 {
1106 push_ref_string(inter_sp, malloced_file);
1107 push_ref_string(inter_sp, malloced_name);
1108 push_number(inter_sp, line_number);
1109 a += 3;
1110 }
1111
1112 push_number(inter_sp, error_caught ? 1 : 0);
1113 a++;
1114
1115 svp = apply_master(STR_HEART_ERROR, a);
1116 command_giver = save_cmd;
1117 if (svp && (svp->type != T_NUMBER || svp->u.number) )
1118 {
1119 debug_message("%s Heart beat in %s turned back on.\n"
1120 , time_stamp(), get_txt(culprit->name));
1121 set_heart_beat(culprit, MY_TRUE);
1122 }
1123 }
1124
1125 /* Handling errors is expensive! */
1126 if (!published_catch)
1127 assigned_eval_cost = eval_cost += MASTER_RESERVED_COST;
1128 }
1129
1130 /* Clean up */
1131 if (malloced_error)
1132 {
1133 free_mstring(malloced_error);
1134 malloced_error = NULL;
1135 }
1136 if (malloced_file)
1137 {
1138 free_mstring(malloced_file);
1139 malloced_file = NULL;
1140 }
1141 if (malloced_name)
1142 {
1143 free_mstring(malloced_name);
1144 malloced_name = NULL;
1145 }
1146
1147 num_error--;
1148
1149 if (current_interactive)
1150 {
1151 interactive_t *i;
1152
1153 if (O_SET_INTERACTIVE(i, current_interactive)
1154 && i->noecho & NOECHO_STALE)
1155 {
1156 set_noecho(i, 0, MY_FALSE, MY_FALSE);
1157 }
1158 }
1159
1160 /* Unroll the context stack and find the recovery context to jump to. */
1161
1162 if (published_catch)
1163 {
1164 unroll_context_stack();
1165 longjmp(((struct error_recovery_info *)rt_context)->con.text, 1);
1166 fatal("Catch() longjump failed");
1167 }
1168
1169 unroll_context_stack();
1170 if (rt_context->type != ERROR_RECOVERY_NONE)
1171 longjmp(((struct error_recovery_info *)rt_context)->con.text, 1);
1172
1173 fatal("Can't recover from error (longjmp failed)\n");
1174 } /* errorf() */
1175
1176 /*-------------------------------------------------------------------------*/
1177 void
warnf(char * fmt,...)1178 warnf (char *fmt, ...)
1179
1180 /* A system runtime warning occured: generate a message from printf-style
1181 * <fmt> with a timestamp, and print it using debug_message(). The message
1182 * is also passed to master::runtime_warning().
1183 *
1184 * Note: Both 'warn' and 'warning' are already taken on some systems.
1185 * TODO: Add a pwarnf(<prefmt>, <postfmt>,...) function which translates the
1186 * TODO:: errno into a string and calls errorf(<prefmt><errmsg><postfmt>, ...).
1187 */
1188
1189 {
1190 char *ts;
1191 string_t *file = NULL; /* program name */
1192 object_t *curobj = NULL; /* Verified current object */
1193 char msg_buf[10000];
1194 /* The buffer for the error message to be created.
1195 */
1196 char fixed_fmt[2000];
1197 /* Note: When changing this buffer, also change the HEAP_STACK_GAP
1198 * limit in xalloc.c!
1199 */
1200 mp_int line_number = 0;
1201 Bool inside_catch;
1202 /* TRUE: Code is executed inside a catch.
1203 */
1204 va_list va;
1205
1206 num_warning++;
1207
1208 ts = time_stamp();
1209
1210 /* Check if this warning occurs inside a catch. */
1211 inside_catch = MY_FALSE;
1212
1213 {
1214 rt_context_t *rt;
1215
1216 for ( rt = rt_context
1217 ; !ERROR_RECOVERY_CONTEXT(rt->type)
1218 ; rt = rt->last) NOOP;
1219
1220 inside_catch = (rt->type >= ERROR_RECOVERY_CATCH);
1221 }
1222
1223 va_start(va, fmt);
1224
1225 /* Make fmt sane */
1226 fmt = limit_error_format(fixed_fmt, sizeof(fixed_fmt), fmt);
1227
1228 /* Check the current object */
1229 curobj = NULL;
1230 if (current_object != NULL
1231 && current_object != &dummy_current_object_for_loads)
1232 curobj = current_object;
1233
1234 if (curobj)
1235 assign_eval_cost();
1236
1237 /* Generate the error message */
1238 vsprintf(msg_buf, fmt, va);
1239 va_end(va);
1240
1241 debug_message("%s ", ts);
1242 debug_message("%s", msg_buf);
1243
1244 /* If we have a current_object, determine the program location
1245 * of the fault.
1246 */
1247 if (curobj)
1248 {
1249 line_number = get_line_number_if_any(&file);
1250 debug_message("%s program: %s, object: %s line %"PRIdMPINT"\n"
1251 , ts, get_txt(file), get_txt(curobj->name)
1252 , line_number);
1253 }
1254
1255 fflush(stdout);
1256
1257 if (num_warning < 3)
1258 {
1259 /* Call master::runtime_warning().
1260 */
1261
1262 object_t * save_cmd = command_giver;
1263
1264 put_c_string(++inter_sp, msg_buf);
1265 if (curobj)
1266 {
1267 if (compat_mode)
1268 push_ref_string(inter_sp, curobj->name);
1269 else
1270 push_string(inter_sp, add_slash(curobj->name));
1271 }
1272 else
1273 push_number(inter_sp, 0);
1274 if (file)
1275 push_ref_string(inter_sp, file);
1276 else
1277 push_number(inter_sp, 0);
1278 push_number(inter_sp, line_number);
1279 push_number(inter_sp, inside_catch ? 1 : 0);
1280
1281 apply_master(STR_WARNING, 5);
1282 command_giver = save_cmd;
1283 }
1284 else
1285 {
1286 if (file)
1287 free_mstring(file);
1288 errorf("Too many nested warnings.\n");
1289 }
1290
1291 if (file)
1292 free_mstring(file);
1293
1294 num_warning--;
1295 } /* warnf() */
1296
1297 /*-------------------------------------------------------------------------*/
1298 void
parse_error(Bool warning,const char * error_file,int line,const char * what,const char * context)1299 parse_error (Bool warning, const char *error_file, int line, const char *what
1300 , const char *context)
1301
1302 /* The compiler found an error <what> (<warning> is FALSE) resp.
1303 * a warning <what> (<warning> is TRUE) while compiling <line> of
1304 * file <error_file>. The context of the error location is <context>.
1305 *
1306 * Log the error by calling master:log_error() (but do not reload
1307 * the master if not existing - the compiler is busy).
1308 */
1309
1310 {
1311 char buff[500];
1312
1313 if (error_file == NULL)
1314 return;
1315 if (strlen(what) + strlen(error_file) > sizeof buff - 100)
1316 what = "...[too long error message]...";
1317 if (strlen(what) + strlen(error_file) > sizeof buff - 100)
1318 error_file = "...[too long filename]...";
1319 sprintf(buff, "%s line %d%s: %s\n", error_file, line, context, what);
1320
1321 /* Don't call the master if it isn't loaded! */
1322 if (master_ob && !(master_ob->flags & O_DESTRUCTED) )
1323 {
1324 push_c_string(inter_sp, error_file);
1325 push_c_string(inter_sp, buff);
1326 push_number(inter_sp, warning ? 1 : 0);
1327 apply_master(STR_LOG_ERROR, 3);
1328 }
1329 } /* parse_error() */
1330
1331 /*-------------------------------------------------------------------------*/
1332 void
throw_error(svalue_t * v)1333 throw_error (svalue_t *v)
1334
1335 /* The efun throw(). We have to save the message <v> in the
1336 * error context and then do the proper longjmp. <v> is freed.
1337 */
1338
1339 {
1340 unroll_context_stack();
1341 if (rt_context->type >= ERROR_RECOVERY_CATCH)
1342 {
1343 transfer_error_message(v, rt_context);
1344 longjmp(((struct error_recovery_info *)rt_context)->con.text, 1);
1345 fatal("Throw_error failed!");
1346 }
1347 free_svalue(v);
1348 errorf("Throw with no catch.\n");
1349 } /* throw_error() */
1350
1351 /*-------------------------------------------------------------------------*/
1352 void
set_svalue_user(svalue_t * svp,object_t * owner)1353 set_svalue_user (svalue_t *svp, object_t *owner)
1354
1355 /* Set the owner of <svp> to object <owner>, if the svalue knows of
1356 * this concept. This may cause a recursive call to this function again.
1357 */
1358
1359 {
1360 switch(svp->type)
1361 {
1362 case T_POINTER:
1363 case T_QUOTED_ARRAY:
1364 set_vector_user(svp->u.vec, owner);
1365 break;
1366 case T_MAPPING:
1367 {
1368 set_mapping_user(svp->u.map, owner);
1369 break;
1370 }
1371 case T_CLOSURE:
1372 {
1373 set_closure_user(svp, owner);
1374 }
1375 }
1376 } /* set_svalue_user() */
1377
1378 /*-------------------------------------------------------------------------*/
1379 static void
give_uid_error_handler(svalue_t * arg)1380 give_uid_error_handler (svalue_t *arg)
1381
1382 /* Error handler for give_uid_to_object(), called automatically when
1383 * the stack is cleant up during the error handling.
1384 * <arg> is a (struct give_uid_error_context*), the action is to destruct
1385 * the object.
1386 */
1387
1388 {
1389 struct give_uid_error_context *ecp;
1390 object_t *ob;
1391
1392 ecp = (struct give_uid_error_context *)arg;
1393 ob = ecp->new_object;
1394 xfree(ecp);
1395
1396 if (ob)
1397 {
1398 destruct(ob);
1399 }
1400 } /* give_uid_error_handler() */
1401
1402 /*-------------------------------------------------------------------------*/
1403 static void
push_give_uid_error_context(object_t * ob)1404 push_give_uid_error_context (object_t *ob)
1405
1406 /* Object <ob> will be given its uids. Push an error handler onto the
1407 * interpreter stack which will clean up <ob> in case of an error.
1408 */
1409
1410 {
1411 struct give_uid_error_context *ecp;
1412
1413 ecp = xalloc(sizeof *ecp);
1414 if (!ecp)
1415 {
1416 destruct(ob);
1417 errorf("Out of memory (%zu bytes) for new object '%s' uids\n"
1418 , sizeof(*ecp), get_txt(ob->name));
1419 }
1420 ecp->new_object = ob;
1421 push_error_handler(give_uid_error_handler, &(ecp->head));
1422 } /* push_give_uid_error_context() */
1423
1424 /*-------------------------------------------------------------------------*/
1425 static Bool
give_uid_to_object(object_t * ob,int hook,int numarg)1426 give_uid_to_object (object_t *ob, int hook, int numarg)
1427
1428 /* Object <ob> was just created - call the driver_hook <hook> with <numarg>
1429 * arguments to give it its uid and euid.
1430 * Return TRUE on success - on failure, destruct <ob>ject and raise
1431 * an error; return FALSE in the unlikely case that errorf() does return.
1432 */
1433
1434 {
1435 lambda_t *l;
1436 char *err, errtxt[1024];
1437 svalue_t arg, *ret;
1438
1439 ob->user = &default_wizlist_entry; /* Default uid */
1440
1441 if ( NULL != (l = driver_hook[hook].u.lambda) )
1442 {
1443 if (driver_hook[hook].x.closure_type == CLOSURE_LAMBDA)
1444 {
1445 free_object(l->ob, "give_uid_to_object");
1446 l->ob = ref_object(ob, "give_uid_to_object");
1447 }
1448 call_lambda(&driver_hook[hook], numarg);
1449 ret = inter_sp;
1450 xfree(ret[-1].u.lvalue); /* free error context */
1451
1452 if (ret->type == T_STRING)
1453 {
1454 ob->user = add_name(ret->u.str);
1455 ob->eff_user = ob->user;
1456 pop_stack(); /* deallocate result */
1457 inter_sp--; /* skip error context */
1458 return MY_TRUE;
1459 }
1460 else if (ret->type == T_POINTER && VEC_SIZE(ret->u.vec) == 2
1461 && ( ret->u.vec->item[0].type == T_STRING
1462 || (!strict_euids && ret->u.vec->item[0].u.number)
1463 )
1464 )
1465 {
1466 ret = ret->u.vec->item;
1467 ob->user = ret[0].type != T_STRING
1468 ? &default_wizlist_entry
1469 : add_name(ret[0].u.str);
1470 ob->eff_user = ret[1].type != T_STRING
1471 ? 0
1472 : add_name(ret[1].u.str);
1473 pop_stack();
1474 inter_sp--;
1475 return MY_TRUE;
1476 }
1477 else if (!strict_euids && ret->type == T_NUMBER && ret->u.number)
1478 {
1479 ob->user = &default_wizlist_entry;
1480 ob->eff_user = NULL;
1481 pop_stack();
1482 inter_sp--;
1483 return MY_TRUE;
1484 }
1485 else
1486 {
1487 pop_stack(); /* deallocate result */
1488 sprintf(errtxt, "Object '%.900s' illegal to load (no uid).\n"
1489 , get_txt(ob->name));
1490 err = errtxt;
1491 }
1492 }
1493 else
1494 {
1495 do pop_stack(); while (--numarg); /* deallocate arguments */
1496 xfree(inter_sp->u.lvalue);
1497 err = "closure to set uid not initialized!\n";
1498 }
1499
1500 inter_sp--; /* skip error context */
1501
1502 if (master_ob == NULL)
1503 {
1504 /* Only for the master object. */
1505 ob->user = add_name(STR_NONAME);
1506 ob->eff_user = NULL;
1507 return MY_TRUE;
1508 }
1509
1510 ob->user = add_name(STR_NONAME);
1511 ob->eff_user = ob->user;
1512 put_object(&arg, ob);
1513 destruct_object(&arg);
1514 errorf("%s", err);
1515 /* NOTREACHED */
1516 return MY_FALSE;
1517 } /* give_uid_to_object() */
1518
1519 /*-------------------------------------------------------------------------*/
1520 const char *
make_name_sane(const char * pName,Bool addSlash)1521 make_name_sane (const char *pName, Bool addSlash)
1522
1523 /* Make a given object name sane.
1524 *
1525 * The function removes leading '/' (if addSlash is true, all but one leading
1526 * '/' are removed), a trailing '.c', and folds consecutive
1527 * '/' into just one '/'. The '.c' removal does not work when given
1528 * clone object names (i.e. names ending in '#<number>').
1529 *
1530 * The function returns a pointer to a static(!) buffer with the cleant
1531 * up name, or NULL if the given name already was sane.
1532 */
1533
1534 {
1535 static char buf[MAXPATHLEN+1];
1536 const char *from = pName;
1537 char *to;
1538 short bDiffers = MY_FALSE;
1539
1540 to = buf;
1541
1542 /* Skip leading '/' */
1543 if (!addSlash)
1544 {
1545 while (*from == '/') {
1546 bDiffers = MY_TRUE;
1547 from++;
1548 }
1549 }
1550 else
1551 {
1552 *to++ = '/';
1553 if (*from != '/')
1554 bDiffers = MY_TRUE;
1555 else
1556 {
1557 from++;
1558 while (*from == '/') {
1559 bDiffers = MY_TRUE;
1560 from++;
1561 }
1562 }
1563 }
1564 /* addSlash or not: from now points to the first non-'/' */
1565
1566 /* Copy the name into buf, doing the other operations */
1567 for (; '\0' != *from && (size_t)(to - buf) < sizeof(buf)
1568 ; from++, to++)
1569 {
1570 if ('/' == *from)
1571 {
1572 *to = '/';
1573 while ('/' == *from) {
1574 from++;
1575 bDiffers = MY_TRUE;
1576 }
1577
1578 from--;
1579 }
1580 else if ('.' == *from && 'c' == *(from+1) && '\0' == *(from+2))
1581 {
1582 bDiffers = MY_TRUE;
1583 break;
1584 }
1585 else
1586 *to = *from;
1587 }
1588 *to = '\0';
1589
1590 if (!bDiffers)
1591 return NULL;
1592
1593 return (const char *)buf;
1594 } /* make_name_sane() */
1595
1596 /*-------------------------------------------------------------------------*/
1597 Bool
check_no_parentdirs(const char * path)1598 check_no_parentdirs (const char *path)
1599
1600 /* Check that there are no '/../' constructs in the path.
1601 * Return TRUE if there aren't.
1602 */
1603
1604 {
1605 char *p;
1606
1607 if (path == NULL)
1608 return MY_FALSE;
1609
1610 for (p = strchr(path, '.'); p; p = strchr(p+1, '.'))
1611 {
1612 if (p[1] != '.')
1613 continue;
1614 if ((p[2] == '\0' || p[2] == '/')
1615 && (p == path || p[-1] == '/')
1616 )
1617 return MY_FALSE;
1618
1619 /* Skip the next '.' as it's safe to do so */
1620 p++;
1621 }
1622 return MY_TRUE;
1623 } /* check_no_parentdirs() */
1624
1625 /*-------------------------------------------------------------------------*/
1626 Bool
legal_path(const char * path)1627 legal_path (const char *path)
1628
1629 /* Check that <path> is a legal relative path. This means no spaces
1630 * and no '/../' are allowed.
1631 * TODO: This should go into a 'files' module.
1632 */
1633 {
1634 if (path == NULL
1635 || (!allow_filename_spaces && strchr(path, ' '))
1636 || path[0] == '/')
1637 return MY_FALSE;
1638
1639 return check_no_parentdirs(path);
1640 } /* legal_path() */
1641
1642 /*-------------------------------------------------------------------------*/
1643 static void load_object_error(const char *msg, const char *name, namechain_t *chain) NORETURN;
1644
1645 static void
load_object_error(const char * msg,const char * name,namechain_t * chain)1646 load_object_error(const char *msg, const char *name, namechain_t *chain)
1647
1648 /* Generate a compilation error message <msg>. If <name> is not NULL,
1649 * ": '<name>'" is appended to the message. If <chain> is not NULL,
1650 * " (inherited by <chain...>)" is appended to the message.
1651 * The message is then printed to stderr and an errorf() with it is thrown.
1652 */
1653
1654 {
1655 strbuf_t sbuf;
1656 namechain_t *ptr;
1657 char * buf;
1658
1659 strbuf_zero(&sbuf);
1660
1661 strbuf_add(&sbuf, msg);
1662 if (name != NULL)
1663 {
1664 strbuf_add(&sbuf, ": '");
1665 strbuf_add(&sbuf, name);
1666 strbuf_add(&sbuf, "'");
1667 }
1668
1669 if (chain != NULL)
1670 {
1671 strbuf_add(&sbuf, " (inherited");
1672 for (ptr = chain; ptr != NULL; ptr = ptr->prev)
1673 {
1674 strbuf_add(&sbuf, " by '");
1675 strbuf_add(&sbuf, ptr->name);
1676 strbuf_add(&sbuf, "'");
1677 }
1678 strbuf_add(&sbuf, ")");
1679 }
1680
1681 strbuf_add(&sbuf, ".\n");
1682
1683 /* Make a local copy of the message so as not to leak memory */
1684 buf = alloca(strbuf_length(&sbuf)+1);
1685 if (!buf)
1686 errorf("Out of stack memory (%zu bytes)\n"
1687 , strlen(sbuf.buf)+1);
1688 strbuf_copy(&sbuf, buf);
1689 strbuf_free(&sbuf);
1690
1691 fprintf(stderr, "%s %s", time_stamp(), buf);
1692 errorf("%.*s", MIN(ERROR_BUF_LEN - 200, (int)strlen(buf)), buf);
1693 } /* load_object_error() */
1694
1695 /*-------------------------------------------------------------------------*/
1696 #define MAX_LOAD_DEPTH 60 /* Make this a configurable constant */
1697
1698 static object_t *
load_object(const char * lname,Bool create_super,int depth,Bool isMasterObj,namechain_t * chain)1699 load_object (const char *lname, Bool create_super, int depth
1700 , Bool isMasterObj, namechain_t *chain)
1701
1702 /* Load (compile) an object blueprint from the file <lname>.
1703 * <create_super> is true if the object has to be
1704 * initialized with CREATE_SUPER, and false if CREATE_OB is to be used.
1705 * <depth> is the current recursive load depth and is checked
1706 * against MAX_LOAD_DEPTH.
1707 * <isMasterObj> is TRUE if the top-level object to be compiled is the master
1708 * object.
1709 * <chain> is the pointer to the calling frame's namechain structure.
1710 *
1711 * If the object can't be loaded because it inherits some other unloaded
1712 * object, call load_object() recursively to load the inherited object, then
1713 * try to load the original object again. This is done in a loop so that
1714 * eventually all missing inherits are loaded.
1715 *
1716 * The name <lname> must be sane object name, and can be a clone name.
1717 *
1718 * If there is no source file <lname>.c, the function calls
1719 * master:compile_object() in case it is a virtual object.
1720 *
1721 * Result is the pointer to the loaded object, or NULL on failure.
1722 */
1723
1724 {
1725 int fd;
1726 object_t *ob;
1727 object_t *save_command_giver = command_giver;
1728 long i;
1729 struct stat c_st;
1730 size_t name_length;
1731 char *name; /* Copy of <lname> */
1732 char *fname; /* Filename for <name> */
1733 program_t *prog;
1734 namechain_t nlink;
1735
1736 #ifdef DEBUG
1737 if ('/' == lname[0])
1738 fatal("Improper filename '%s' passed to load_object()\n", lname);
1739 #endif
1740
1741 /* Empty lnames (/.c in Mudlib) *should* be OK. But use at your own risk. ;-)
1742 */
1743 name_length = strlen(lname);
1744
1745 /* It could be that the passed filename is one of an already loaded
1746 * object. In that case, simply return that object.
1747 */
1748 ob = lookup_object_hash_str((char *)lname);
1749 if (ob)
1750 {
1751 return ob;
1752 }
1753
1754 /* We need two copies of <lname>: one to construct the filename in,
1755 * the second because lname might be a buffer which is deleted
1756 * during the compilation process.
1757 * The memory is allocated in one chunk for both strings and an error
1758 * handler is pushed on the stack (additionally is needed: memory for '/'
1759 * and '\0’ (sizeof("/")) and '/', '\0', '.' and 'c' (sizeof("/.c"))).
1760 */
1761 name = xalloc_with_error_handler(2 * name_length + sizeof("/") +
1762 sizeof("/.c"));
1763 fname = name + name_length + sizeof("/") + 1;
1764 if (!name)
1765 errorf("Out of memory (%zu bytes) in load_object() for temporary name "
1766 "buffers.\n", 2*name_length + sizeof("/") + sizeof("/.c"));
1767
1768 if (!compat_mode)
1769 *name++ = '/'; /* Add and hide a leading '/' */
1770 strcpy(name, lname);
1771 strcpy(fname, lname);
1772
1773 nlink.name = name;
1774 nlink.prev = chain;
1775
1776 if (strict_euids && current_object && current_object->eff_user == 0
1777 && current_object->name)
1778 errorf("Can't load objects when no effective user.\n");
1779
1780 if (master_ob && master_ob->flags & O_DESTRUCTED)
1781 {
1782 /* The master has been destructed, and it has not been noticed yet.
1783 * Reload it, because it can't be done inside of yyparse.
1784 * assert_master_ob_loaded() will clear master_ob while reloading is
1785 * in progress, thus preventing a fatal recursion.
1786 */
1787 assert_master_ob_loaded();
1788 /* has the object been loaded by assert_master_ob_loaded ? */
1789 if ( NULL != (ob = find_object_str(name)) )
1790 {
1791 if (ob->flags & O_SWAPPED && load_ob_from_swap(ob) < 0)
1792 /* The master has swapped this object and used up most
1793 * memory... strange, but thinkable
1794 */
1795 errorf("Out of memory: unswap object '%s'\n", get_txt(ob->name));
1796 pop_stack(); /* free error handler */
1797 return ob;
1798 }
1799 }
1800
1801 /* Check if the name follows the "name#number" pattern */
1802 {
1803 char c;
1804 char *p;
1805
1806 i = name_length;
1807 p = name+name_length;
1808 while (--i > 0) {
1809 /* isdigit would need to check isascii first... */
1810 if ( (c = *--p) < '0' || c > '9' ) {
1811 if (c == '#' && name_length - i > 1)
1812 {
1813 load_object_error("Illegal file to load", name, chain);
1814 /* NOTREACHED */
1815 }
1816 break;
1817 }
1818 }
1819 }
1820
1821 /* Check if we were already trying to compile this object */
1822 if (chain != NULL)
1823 {
1824 namechain_t * ptr;
1825
1826 for (ptr = chain; ptr != NULL; ptr = ptr->prev)
1827 {
1828 if (!strcmp(name, ptr->name))
1829 load_object_error("Recursive inherit", name, chain);
1830 }
1831 }
1832
1833 /* Check that the c-file exists.
1834 */
1835 (void)strcpy(fname+name_length, ".c");
1836 if (ixstat(fname, &c_st) == -1)
1837 {
1838 /* The file does not exist - maybe it's a virtual object */
1839
1840 svalue_t *svp;
1841
1842 push_c_string(inter_sp, fname);
1843 svp = apply_master(STR_COMPILE_OBJECT, 1);
1844 if (svp && svp->type == T_OBJECT)
1845 {
1846 /* We got an object from the call, but is it what it
1847 * claims to be?
1848 */
1849 if ( NULL != (ob = lookup_object_hash_str(name)) )
1850 {
1851 /* An object for <name> magically appeared - is it
1852 * the one we received?
1853 */
1854 if (ob == svp->u.ob)
1855 {
1856 /* If this object is a clone, clear the clone flag
1857 * but mark it as replaced.
1858 */
1859 if (ob->flags & O_CLONE)
1860 {
1861 ob->flags &= ~O_CLONE;
1862 ob->flags |= O_REPLACED;
1863 }
1864 pop_stack(); /* free error handler */
1865 return ob;
1866 }
1867 }
1868 else if (ob != master_ob)
1869 {
1870 /* Rename the object we got to the name it
1871 * is supposed to have.
1872 */
1873 ob = svp->u.ob;
1874 remove_object_hash(ob);
1875 free_mstring(ob->name);
1876 ob->name = new_mstring(name);
1877 enter_object_hash(ob);
1878
1879 /* If this object is a clone, clear the clone flag
1880 * but mark it as replaced.
1881 */
1882 if (ob->flags & O_CLONE)
1883 {
1884 ob->flags &= ~O_CLONE;
1885 ob->flags |= O_REPLACED;
1886 }
1887 pop_stack(); /* free error handler */
1888 return ob;
1889 }
1890 fname[name_length] = '.';
1891 }
1892 load_object_error("Failed to load file", name, chain);
1893 /* NOTREACHED */
1894 return NULL;
1895 }
1896
1897 /* Check if it's a legal name.
1898 */
1899 if (!legal_path(fname))
1900 {
1901 load_object_error("Illegal pathname", fname, chain);
1902 /* NOTREACHED */
1903 return NULL;
1904 }
1905
1906 /* The compilation loop. It will run until either <name> is loaded
1907 * or an error occurs. If the compilation is aborted because an
1908 * inherited object was not found, that object is loaded in a
1909 * recursive call, then the loop will try again on the original
1910 * object.
1911 */
1912
1913 while (MY_TRUE)
1914 {
1915 /* This can happen after loading an inherited object: */
1916 ob = lookup_object_hash_str((char *)name);
1917 if (ob)
1918 {
1919 pop_stack(); /* free error handler */
1920 return ob;
1921 }
1922
1923 if (comp_flag)
1924 fprintf(stderr, "%s compiling %s ...", time_stamp(), fname);
1925
1926 if (current_loc.file)
1927 {
1928 errorf("Can't load '%s': compiler is busy with '%s'.\n"
1929 , name, current_loc.file->name);
1930 }
1931
1932 fd = ixopen(fname, O_RDONLY | O_BINARY);
1933 if (fd <= 0)
1934 {
1935 perror(fname);
1936 errorf("Could not read the file.\n");
1937 }
1938 FCOUNT_COMP(fname);
1939
1940 /* The file name is needed before compile_file(), in case there is
1941 * an initial 'line too long' error.
1942 */
1943 compile_file(fd, fname, isMasterObj);
1944 if (comp_flag)
1945 {
1946 if (NULL == inherit_file)
1947 fprintf(stderr, " done\n");
1948 else
1949 {
1950 fprintf(stderr, " needs inherit\n");
1951 }
1952 }
1953
1954 update_compile_av(total_lines);
1955 total_lines = 0;
1956 (void)close(fd);
1957
1958 /* If there is no inherited file to compile, we can
1959 * end the loop here.
1960 */
1961 if (NULL == inherit_file)
1962 break;
1963
1964 /* This object wants to inherit an unloaded object. We discard
1965 * current object, load the object to be inherited and reload
1966 * the current object again. The global variable "inherit_file"
1967 * was set by lang.y to point to a file name.
1968 */
1969 {
1970 char * pInherited;
1971 const char * tmp;
1972
1973 tmp = make_name_sane(get_txt(inherit_file), MY_FALSE);
1974 if (!tmp)
1975 {
1976 pInherited = get_txt(inherit_file);
1977 }
1978 else
1979 {
1980 pInherited = alloca(strlen(tmp)+1);
1981 strcpy(pInherited, tmp);
1982 }
1983
1984 push_string(inter_sp, inherit_file);
1985 /* Automagic freeing in case of errors */
1986 inherit_file = NULL;
1987
1988 /* Now that the inherit_file-string will be freed in case
1989 * of an error, we can check if there were other errors
1990 * besides the missing inherit.
1991 */
1992 if (num_parse_error > 0)
1993 {
1994 load_object_error("Error in loading object", name, chain);
1995 }
1996
1997 if (strcmp(pInherited, name) == 0)
1998 {
1999 errorf("Illegal to inherit self.\n");
2000 }
2001
2002 if (depth >= MAX_LOAD_DEPTH)
2003 {
2004 load_object_error("Too deep inheritance", name, chain);
2005 }
2006
2007 ob = load_object(pInherited, MY_TRUE, depth+1, isMasterObj, &nlink);
2008 free_mstring(inter_sp->u.str);
2009 inter_sp--;
2010 if (!ob || ob->flags & O_DESTRUCTED)
2011 {
2012 load_object_error("Error in loading object "
2013 "(inheritance failed)\n", name, chain);
2014 }
2015 } /* handling of inherit_file */
2016 } /* while() - compilation loop */
2017
2018 /* Did the compilation succeed? */
2019 if (num_parse_error > 0)
2020 {
2021 load_object_error("Error in loading object", name, chain);
2022 }
2023
2024 /* We got the program. Now create the blueprint to hold it.
2025 */
2026
2027 if (NULL != (ob = lookup_object_hash_str(name)))
2028 {
2029 /* The object magically appeared!
2030 * This can happen if rename_object() is used carelessly
2031 * in the mudlib handler for compiler warnings.
2032 */
2033 free_prog(compiled_prog, MY_TRUE);
2034 load_object_error("Object appeared while it was compiled"
2035 , name, chain);
2036 /* NOTREACHED */
2037 return NULL;
2038 }
2039
2040 prog = compiled_prog;
2041
2042 ob = get_empty_object(prog->num_variables);
2043
2044 if (!ob)
2045 errorf("Out of memory for new object '%s'\n", name);
2046
2047 ob->name = new_mstring(name);
2048 #ifdef CHECK_OBJECT_STAT
2049 if (check_object_stat)
2050 {
2051 fprintf(stderr, "DEBUG: OSTAT: (%ld:%ld) load( %p '%s') name: %zu -> (%ld:%ld)\n"
2052 , tot_alloc_object, tot_alloc_object_size, ob, ob->name ? get_txt(ob->name) : "<null>"
2053 , mstrsize(ob->name)
2054 , tot_alloc_object
2055 , tot_alloc_object_size + (mstrsize(ob->name))
2056 );
2057 }
2058 #endif
2059 tot_alloc_object_size += mstrsize(ob->name);
2060 /* Tabling this unique string is of not much use.
2061 * Note that the string must be valid for the ref_object()
2062 * below to work in debugging mode.
2063 */
2064
2065 prog->blueprint = ref_object(ob, "load_object: blueprint reference");
2066
2067 if (!compat_mode)
2068 name--; /* Make the leading '/' visible again */
2069 ob->load_name = new_tabled(name); /* but here it is */
2070 ob->prog = prog;
2071 ob->ticks = ob->gigaticks = 0;
2072 ob->next_all = obj_list;
2073 ob->prev_all = NULL;
2074 if (obj_list)
2075 obj_list->prev_all = ob;
2076 obj_list = ob;
2077 if (!obj_list_end)
2078 obj_list_end = ob;
2079 num_listed_objs++;
2080 enter_object_hash(ob); /* add name to fast object lookup table */
2081
2082 /* Give the object its uids */
2083 push_give_uid_error_context(ob);
2084 push_ref_string(inter_sp, ob->name);
2085 if (give_uid_to_object(ob, H_LOAD_UIDS, 1))
2086 {
2087 /* The object has an uid - now we can update the .user
2088 * of its initializers.
2089 */
2090 svalue_t *svp;
2091 int j;
2092 object_t *save_current;
2093
2094 save_current = current_object;
2095 current_object = ob; /* just in case */
2096 svp = ob->variables;
2097 for (j = ob->prog->num_variables; --j >= 0; svp++)
2098 {
2099 if (svp->type == T_NUMBER)
2100 continue;
2101 set_svalue_user(svp, ob);
2102 }
2103
2104 if (save_current == &dummy_current_object_for_loads)
2105 {
2106 /* The master object is loaded with no current object */
2107 current_object = NULL;
2108 }
2109 else
2110 {
2111 current_object = save_current;
2112 }
2113
2114 if (ob->flags & O_DESTRUCTED)
2115 {
2116 warnf("Object '%s' was destroyed before initialization.\n"
2117 , get_txt(ob->name));
2118 return NULL;
2119 }
2120 init_object_variables(ob, NULL);
2121
2122 if (ob->flags & O_DESTRUCTED)
2123 {
2124 warnf("Object '%s' was destroyed during initialization.\n"
2125 , get_txt(ob->name));
2126 return NULL;
2127 }
2128 reset_object(ob, create_super ? H_CREATE_SUPER : H_CREATE_OB);
2129
2130 /* If the master inherits anything -Ugh- we have to have
2131 * some object to attribute initialized variables to.
2132 */
2133 current_object = save_current;
2134 }
2135
2136 if ( !(ob->flags & O_DESTRUCTED))
2137 ob->flags |= O_WILL_CLEAN_UP;
2138
2139 /* free the error handler with the buffer for name and fname. */
2140 pop_stack();
2141
2142 /* Restore the command giver */
2143 command_giver = check_object(save_command_giver);
2144
2145 if (d_flag > 1 && ob)
2146 {
2147 debug_message("%s --%s loaded\n", time_stamp(), get_txt(ob->name));
2148 }
2149
2150 #if 0 && defined(CHECK_OBJECT_REF)
2151 if (strchr(get_txt(ob->name), '#') == NULL)
2152 printf("DEBUG: new_object(%p '%s') ref %"PRIdPINT" flags %x\n"
2153 , ob, get_txt(ob->name), ob->ref, ob->flags);
2154 #endif
2155 return ob;
2156 } /* load_object() */
2157
2158 /*-------------------------------------------------------------------------*/
2159 static string_t *
make_new_name(string_t * str)2160 make_new_name (string_t *str)
2161
2162 /* <str> is a basic object name - generate a clone name "<str>#<num>"
2163 * and return it. The result will be an untabled string with one reference.
2164 *
2165 * The number is guaranteed to be unique in combination with this name.
2166 */
2167
2168 {
2169 static unsigned long clone_id_number = 0;
2170 /* The next number to use for a clone name */
2171
2172 static int test_conflict = MY_FALSE;
2173 /* TRUE if the generated clone name has to be tested for uniqueness.
2174 * This is not the case before clone_id_number wraps around the
2175 * first time.
2176 */
2177
2178 string_t *p;
2179 char buff[40];
2180
2181 str = del_slash(str);
2182
2183 for (;;)
2184 {
2185 /* Generate the clone name */
2186 (void)sprintf(buff, "#%lu", clone_id_number);
2187 p = mstr_add_txt(str, buff, strlen(buff));
2188
2189 clone_id_number++;
2190 if (clone_id_number == 0) /* Wrap around */
2191 test_conflict = MY_TRUE;
2192
2193 if (!test_conflict || !find_object(p))
2194 {
2195 free_mstring(str);
2196 return p;
2197 }
2198
2199 /* The name was already taken */
2200 free_mstring(p);
2201 }
2202 } /* make_new_name() */
2203
2204 /*-------------------------------------------------------------------------*/
2205 static object_t *
clone_object(string_t * str1)2206 clone_object (string_t *str1)
2207
2208 /* Create a clone of the object named <str1>, which may be a clone itself.
2209 * On success, return the new object, otherwise NULL.
2210 */
2211
2212 {
2213 object_t *ob, *new_ob;
2214 object_t *save_command_giver = command_giver;
2215 string_t *name;
2216
2217 if (strict_euids && current_object && current_object->eff_user == NULL)
2218 errorf("Illegal to call clone_object() with effective user 0\n");
2219
2220 ob = get_object(str1);
2221
2222 /* If the object self-destructed...
2223 */
2224 if (ob == NULL)
2225 return NULL;
2226
2227 /* If ob is a clone, try finding the blueprint first via the object's
2228 * program, then via the load_name.
2229 */
2230 if (ob->flags & O_CLONE)
2231 {
2232 object_t *bp = NULL;
2233
2234 /* If the object's program hasn't been replaced, it most likely
2235 * contains a pointer to the blueprint we're looking for.
2236 */
2237 if (!(ob->flags & O_REPLACED))
2238 {
2239 bp = ob->prog->blueprint;
2240 if (bp && (bp->flags & O_DESTRUCTED))
2241 {
2242 free_object(bp, "clone_object");
2243 bp = ob->prog->blueprint = NULL;
2244 }
2245 }
2246
2247 /* Fallback: find/load the blueprint by the load_name */
2248 if (!bp)
2249 bp = get_object(ob->load_name);
2250 if (bp)
2251 ob = bp;
2252 }
2253
2254 if (ob->super)
2255 errorf("Cloning a bad object: '%s' is contained in '%s'.\n"
2256 , get_txt(ob->name), get_txt(ob->super->name));
2257
2258 name = ob->name;
2259
2260 /* If the ob is a clone, we have to test if its name is something
2261 * illegal like 'foobar#34'. In that case, we have to use the
2262 * load_name as template.
2263 */
2264 if (ob->flags & O_CLONE)
2265 {
2266 char c;
2267 char *p;
2268 mp_int name_length, i;
2269
2270 name_length = mstrsize(name);
2271 i = name_length;
2272 p = get_txt(ob->name)+name_length;
2273 while (--i > 0) {
2274 /* isdigit would need to check isascii first... */
2275 if ( (c = *--p) < '0' || c > '9' )
2276 {
2277 if (c == '#' && name_length - i > 1)
2278 {
2279 /* Well, unusable name format - use the load_name */
2280 name = ob->load_name;
2281 }
2282 break;
2283 }
2284 }
2285 }
2286
2287 if ((ob->flags & O_SWAPPED) && load_ob_from_swap(ob) < 0)
2288 errorf("Out of memory: unswap object '%s'\n", get_txt(ob->name));
2289
2290 if (ob->prog->flags & P_NO_CLONE)
2291 errorf("Cloning a bad object: '%s' sets '#pragma no_clone'.\n"
2292 , get_txt(ob->name));
2293
2294 ob->time_of_ref = current_time;
2295
2296 /* Got the blueprint - now get a new object */
2297
2298 new_ob = get_empty_object(ob->prog->num_variables);
2299 if (!new_ob)
2300 errorf("Out of memory for new clone '%s'\n", get_txt(name));
2301
2302 new_ob->name = make_new_name(name);
2303
2304 #ifdef CHECK_OBJECT_STAT
2305 if (check_object_stat)
2306 {
2307 fprintf(stderr, "DEBUG: OSTAT: (%ld:%ld) clone( %p '%s') name: %zu -> (%ld:%ld)\n"
2308 , tot_alloc_object, tot_alloc_object_size, new_ob, new_ob->name ? get_txt(new_ob->name) : "<null>"
2309 , mstrsize(new_ob->name)
2310 , tot_alloc_object
2311 , tot_alloc_object_size + (mstrsize(new_ob->name))
2312 );
2313 }
2314 #endif
2315 tot_alloc_object_size += mstrsize(new_ob->name);
2316 new_ob->load_name = ref_mstring(ob->load_name);
2317 new_ob->flags |= O_CLONE | O_WILL_CLEAN_UP;
2318 new_ob->prog = ob->prog;
2319 reference_prog (ob->prog, "clone_object");
2320 new_ob->ticks = new_ob->gigaticks = 0;
2321 #ifdef DEBUG
2322 if (!current_object)
2323 fatal("clone_object() from no current_object !\n");
2324 #endif
2325 new_ob->next_all = obj_list;
2326 new_ob->prev_all = NULL;
2327 if (obj_list)
2328 obj_list->prev_all = new_ob;
2329 obj_list = new_ob;
2330 if (!obj_list_end)
2331 obj_list_end = new_ob;
2332 num_listed_objs++;
2333 enter_object_hash(new_ob); /* Add name to fast object lookup table */
2334 push_give_uid_error_context(new_ob);
2335 push_ref_object(inter_sp, ob, "clone_object");
2336 push_ref_string(inter_sp, new_ob->name);
2337 give_uid_to_object(new_ob, H_CLONE_UIDS, 2);
2338
2339 if (new_ob->flags & O_DESTRUCTED)
2340 {
2341 warnf("Object '%s' was destroyed before initialization.\n"
2342 , get_txt(new_ob->name));
2343 return NULL;
2344 }
2345 init_object_variables(new_ob, ob);
2346
2347 if (new_ob->flags & O_DESTRUCTED)
2348 {
2349 warnf("Object '%s' was destroyed during initialization.\n"
2350 , get_txt(new_ob->name));
2351 return NULL;
2352 }
2353 reset_object(new_ob, H_CREATE_CLONE);
2354 command_giver = check_object(save_command_giver);
2355
2356 /* Never know what can happen ! :-( */
2357 if (new_ob->flags & O_DESTRUCTED)
2358 return NULL;
2359
2360 return new_ob;
2361 } /* clone_object() */
2362
2363 /*-------------------------------------------------------------------------*/
2364 object_t *
lookfor_object(string_t * str,Bool bLoad)2365 lookfor_object (string_t * str, Bool bLoad)
2366
2367 /* Look for a named object <str>, optionally loading it (<bLoad> is true).
2368 * Return a pointer to the object structure, or NULL.
2369 *
2370 * If <bLoad> is true, the function tries to load the object if it is
2371 * not already loaded.
2372 * If <bLoad> is false, the function just checks if the object is loaded.
2373 *
2374 * The object is not swapped in.
2375 *
2376 * For easier usage, the macros find_object() and get_object() expand
2377 * to the no-load- resp. load-call of this function.
2378 *
2379 * TODO: It would be nice if all loading uses of lookfor would go through
2380 * TODO:: the efun load_object() or a driver hook so that the mudlib
2381 * TODO:: has a chance to interfere with it. Dito for clone_object(), so
2382 * TODO:: that the euid-check can be done there?
2383 */
2384 {
2385 object_t *ob;
2386 const char * pName;
2387 Bool isMasterObj = MY_FALSE;
2388
2389 if (mstreq(str, master_name_str))
2390 isMasterObj = MY_TRUE;
2391
2392 /* TODO: It would be more useful to check all callers of lookfor()
2393 * TODO:: and move the make_name_sane() into those where it can
2394 * TODO:: be dirty.
2395 */
2396 pName = make_name_sane(get_txt(str), MY_FALSE);
2397 if (!pName)
2398 pName = get_txt(str);
2399
2400 if (!isMasterObj && !strcmp(pName, get_txt(master_name_str)))
2401 isMasterObj = MY_TRUE;
2402
2403 ob = lookup_object_hash_str(pName);
2404 if (!bLoad)
2405 return ob;
2406
2407 if (!ob)
2408 {
2409 ob = load_object(pName, 0, 0, isMasterObj, NULL);
2410 }
2411 if (!ob || ob->flags & O_DESTRUCTED)
2412 return NULL;
2413 return ob;
2414 } /* lookfor_object() */
2415
2416 /*-------------------------------------------------------------------------*/
2417 object_t *
find_object_str(const char * str)2418 find_object_str (const char * str)
2419
2420 /* Look for a named object <str>.
2421 * Return a pointer to the object structure, or NULL.
2422 *
2423 * The object is not swapped in.
2424 */
2425 {
2426 const char * pName;
2427
2428 /* TODO: It would be more useful to check all callers of lookfor()
2429 * TODO:: and move the make_name_sane() into those where it can
2430 * TODO:: be dirty.
2431 */
2432 pName = make_name_sane(str, MY_FALSE);
2433 if (!pName)
2434 pName = str;
2435
2436 return lookup_object_hash_str(pName);
2437 } /* find_object_str() */
2438
2439 /*-------------------------------------------------------------------------*/
2440 void
destruct_object(svalue_t * v)2441 destruct_object (svalue_t *v)
2442
2443 /* Destruct the object named/passed in svalue <v>.
2444 * This is the full program: the master:prepare_destruct() is called
2445 * to clean the inventory of the object, and if it's an interactive,
2446 * it is given the chance to save a pending editor buffer.
2447 *
2448 * The actual destruction work is then done in destruct().
2449 */
2450
2451 {
2452 object_t *ob;
2453 svalue_t *result;
2454
2455 /* Get the object to destruct */
2456 if (v->type == T_OBJECT)
2457 ob = v->u.ob;
2458 else
2459 {
2460 ob = find_object(v->u.str);
2461 if (ob == 0)
2462 errorf("destruct_object: Could not find %s\n", get_txt(v->u.str));
2463 }
2464
2465 if (ob->flags & O_DESTRUCTED)
2466 return;
2467
2468 if (ob->flags & O_SWAPPED)
2469 if (load_ob_from_swap(ob) < 0)
2470 errorf("Out of memory: unswap object '%s'\n", get_txt(ob->name));
2471
2472 if (d_flag)
2473 {
2474 debug_message("%s destruct_object: %s (ref %"PRIdPINT")\n"
2475 , time_stamp(), get_txt(ob->name), ob->ref);
2476 }
2477
2478 push_ref_object(inter_sp, ob, "destruct");
2479 result = apply_master(STR_PREP_DEST, 1);
2480 if (!result)
2481 errorf("No prepare_destruct\n");
2482
2483 if (result->type == T_STRING)
2484 errorf("%s", get_txt(result->u.str));
2485
2486 if (result->type != T_NUMBER || result->u.number != 0)
2487 return;
2488
2489 if (ob->contains)
2490 {
2491 errorf("Master failed to clean inventory in prepare_destruct\n");
2492 }
2493
2494 if (O_IS_INTERACTIVE(ob))
2495 {
2496 interactive_t *ip = O_GET_INTERACTIVE(ob);
2497 object_t *save = command_giver;
2498
2499 command_giver = ob;
2500 trace_level |= ip->trace_level;
2501
2502 abort_input_handler(ip);
2503
2504 command_giver = save;
2505 }
2506 destruct(ob);
2507 } /* destruct_object() */
2508
2509 /*-------------------------------------------------------------------------*/
2510 void
deep_destruct(object_t * ob)2511 deep_destruct (object_t *ob)
2512
2513 /* Destruct an object <ob> and the blueprint objects of all inherited
2514 * programs. The actual destruction work is done by destruct().
2515 *
2516 * The objects are still kept around until the end of the execution because
2517 * it might still hold a running program. The destruction will be completed
2518 * from the backend by a call to handle_newly_destructed_objects().
2519 */
2520
2521 {
2522 program_t *prog;
2523
2524 /* Destruct the object itself */
2525 destruct(ob);
2526
2527 /* Loop through all the inherits and destruct the blueprints
2528 * of the inherited programs.
2529 */
2530 prog = ob->prog;
2531 if (prog != NULL)
2532 {
2533 int i;
2534
2535 for (i = 0; i < prog->num_inherited; ++i)
2536 {
2537 program_t *iprog = prog->inherit[i].prog;
2538
2539 if (iprog != NULL && iprog->blueprint != NULL)
2540 {
2541 destruct(iprog->blueprint);
2542 }
2543 }
2544 }
2545 } /* deep_destruct() */
2546
2547 /*-------------------------------------------------------------------------*/
2548 void
destruct(object_t * ob)2549 destruct (object_t *ob)
2550
2551 /* Really destruct an object <ob>. This function is called from
2552 * destruct_object() to do the actual work, and also directly in situations
2553 * where the master is out of order or the object not fully initialized.
2554 *
2555 * The function:
2556 * - marks the object as destructed
2557 * - moves it out of the global object list and the object able, into
2558 * the list of destructed objects
2559 * - changes all references on the interpreter stack to svalue-0
2560 * - moves it out of its environment
2561 * - removes all shadows.
2562 *
2563 * The object is still kept around until the end of the execution because
2564 * it might still hold a running program. The destruction will be completed
2565 * from the backend by a call to handle_newly_destructed_objects().
2566 */
2567
2568 {
2569 object_t **pp, *item, *next;
2570 #ifdef CHECK_OBJECT_REF
2571 object_shadow_t *shadow;
2572 #endif /* CHECK_OBJECT_REF */
2573
2574 if (ob->flags & O_DESTRUCTED)
2575 return;
2576
2577 #ifdef CHECK_OBJECT_REF
2578 xallocate(shadow, sizeof(*shadow), "destructed object shadow");
2579 #endif /* CHECK_OBJECT_REF */
2580 #ifdef USE_SQLITE
2581 if (ob->open_sqlite_db)
2582 sl_close(ob);
2583 #endif
2584 ob->time_reset = 0;
2585
2586 /* We need the object in memory */
2587 if (ob->flags & O_SWAPPED)
2588 {
2589 int save_privilege;
2590
2591 save_privilege = malloc_privilege;
2592 malloc_privilege = MALLOC_SYSTEM;
2593 load_ob_from_swap(ob);
2594 malloc_privilege = save_privilege;
2595 }
2596
2597 /* If there are shadows, remove them */
2598 if (ob->flags & O_SHADOW)
2599 {
2600 shadow_t *shadow_sent;
2601 object_t *shadowing, *shadowed_by;
2602
2603 shadow_sent = O_GET_SHADOW(ob);
2604
2605 /* The chain of shadows is a double linked list. Take care to update
2606 * it correctly.
2607 */
2608 if ( NULL != (shadowing = shadow_sent->shadowing) )
2609 {
2610 shadow_t *shadowing_sent;
2611
2612 /* Remove the shadow sent from the chain */
2613 shadowing_sent = O_GET_SHADOW(shadowing);
2614 shadow_sent->shadowing = NULL;
2615 shadowing_sent->shadowed_by = shadow_sent->shadowed_by;
2616 check_shadow_sent(shadowing);
2617
2618 /* This object, the shadow, may have added actions to
2619 * the shadowee, or it's vicinity. Take care to remove
2620 * them all.
2621 */
2622 remove_shadow_actions(ob, shadowing);
2623 }
2624
2625 if ( NULL != (shadowed_by = shadow_sent->shadowed_by) )
2626 {
2627 shadow_t *shadowed_by_sent;
2628
2629 /* Remove the shadow sent from the chain */
2630 shadowed_by_sent = O_GET_SHADOW(shadowed_by);
2631 shadow_sent->shadowed_by = NULL;
2632 shadowed_by_sent->shadowing = shadowing;
2633 check_shadow_sent(shadowed_by);
2634
2635 /* Our shadows may have added actions to us or to our
2636 * environment. Take care to remove them all.
2637 */
2638 do {
2639 remove_shadow_actions(shadowed_by, ob);
2640 if (O_GET_SHADOW(shadowed_by) != NULL)
2641 shadowed_by = O_GET_SHADOW(shadowed_by)->shadowed_by;
2642 else
2643 shadowed_by = NULL;
2644 } while (shadowed_by != NULL);
2645 }
2646
2647 check_shadow_sent(ob);
2648 }
2649
2650 /* Move all objects in the inventory into the "void" */
2651 for (item = ob->contains; item; item = next)
2652 {
2653 remove_action_sent(ob, item);
2654 item->super = NULL;
2655 next = item->next_inv;
2656 item->next_inv = NULL;
2657 }
2658
2659 remove_object_from_stack(ob);
2660
2661 if (ob == simul_efun_object)
2662 {
2663 simul_efun_object = NULL;
2664 invalidate_simul_efuns();
2665 }
2666
2667 set_heart_beat(ob, MY_FALSE);
2668
2669 /* Remove us out of this current room (if any).
2670 * Remove all sentences defined by this object from all objects here.
2671 */
2672 if (ob->super)
2673 {
2674 if (ob->super->sent)
2675 remove_action_sent(ob, ob->super);
2676
2677 # ifdef USE_SET_LIGHT
2678 add_light(ob->super, - ob->total_light);
2679 # endif
2680
2681 for (pp = &ob->super->contains; *pp;)
2682 {
2683 if ((*pp)->sent)
2684 remove_action_sent(ob, *pp);
2685 if (*pp != ob)
2686 pp = &(*pp)->next_inv;
2687 else
2688 *pp = (*pp)->next_inv;
2689 }
2690 }
2691
2692 /* Now remove us out of the list of all objects.
2693 * This must be done last, because an error in the above code would
2694 * halt execution.
2695 */
2696 remove_object_hash(ob);
2697 if (ob->prev_all)
2698 ob->prev_all->next_all = ob->next_all;
2699 if (ob->next_all)
2700 ob->next_all->prev_all = ob->prev_all;
2701 if (ob == obj_list)
2702 obj_list = ob->next_all;
2703 if (ob == obj_list_end)
2704 obj_list_end = ob->prev_all;
2705
2706 num_listed_objs--;
2707
2708 ob->super = NULL;
2709 ob->next_inv = NULL;
2710 ob->contains = NULL;
2711 ob->flags &= ~O_ENABLE_COMMANDS;
2712 ob->flags |= O_DESTRUCTED; /* must come last! */
2713 if (command_giver == ob)
2714 command_giver = NULL;
2715
2716 /* Put the object into the list of newly destructed objects */
2717 ob->prev_all = NULL;
2718 ob->next_all = newly_destructed_objs;
2719 newly_destructed_objs = ob;
2720 num_newly_destructed++;
2721 #ifdef CHECK_OBJECT_REF
2722 shadow->obj = ob;
2723 shadow->ref = ob->ref;
2724 shadow->flags = ob->flags;
2725 shadow->sent = ob->sent;
2726 shadow->next = newly_destructed_obj_shadows;
2727 newly_destructed_obj_shadows = shadow;
2728 #endif /* CHECK_OBJECT_REF */
2729 } /* destruct() */
2730
2731 #ifdef CHECK_OBJECT_REF
2732 /*-------------------------------------------------------------------------*/
2733 void
check_object_shadow(object_t * ob,object_shadow_t * sh)2734 check_object_shadow (object_t *ob, object_shadow_t *sh)
2735 {
2736 if (sh->obj != ob)
2737 fatal("DEBUG: Obj %p '%s', shadow %p -> obj %p '%s'\n"
2738 , ob, get_txt(ob->name), sh, sh->obj, get_txt(sh->obj->name));
2739 if ((sh->flags & O_DESTRUCTED) != (ob->flags & O_DESTRUCTED)
2740 || sh->sent != ob->sent
2741 )
2742 fatal("DEBUG: Obj %p '%s': ref %"PRIdPINT", flags %x, sent %p;"
2743 "shadow ref %"PRIdPINT", flags %x, sent %p\n"
2744 , ob, get_txt(ob->name), ob->ref, ob->flags, ob->sent
2745 , sh->ref, sh->flags, sh->sent
2746 );
2747 } /* check_object_shadow() */
2748
2749 void
check_all_object_shadows(void)2750 check_all_object_shadows (void)
2751 {
2752 object_shadow_t *sh;
2753 object_t * ob;
2754
2755 for (ob = newly_destructed_objs, sh = newly_destructed_obj_shadows
2756 ; ob != NULL
2757 ; ob = ob->next_all, sh = sh->next
2758 )
2759 check_object_shadow(ob, sh);
2760
2761 for (ob = destructed_objs, sh = destructed_obj_shadows
2762 ; ob != NULL
2763 ; ob = ob->next_all, sh = sh->next
2764 )
2765 check_object_shadow(ob, sh);
2766 } /* check_object_shadows() */
2767
2768 void
update_object_sent(object_t * obj,sentence_t * new_sent)2769 update_object_sent(object_t *obj, sentence_t *new_sent)
2770 {
2771 object_shadow_t *sh;
2772 if (!(obj->flags & O_DESTRUCTED))
2773 {
2774 obj->sent = new_sent;
2775 return;
2776 }
2777 for (sh = newly_destructed_obj_shadows; sh != NULL; sh = sh->next)
2778 if (sh->obj == obj)
2779 break;
2780 if (sh == NULL)
2781 for (sh = newly_destructed_obj_shadows; sh != NULL; sh = sh->next)
2782 if (sh->obj == obj)
2783 break;
2784 if (sh == NULL)
2785 {
2786 fatal("DEBUG: Obj %p '%s': ref %"PRIdPINT", flags %x, sent %p; no shadow found\n"
2787 , obj, get_txt(obj->name), obj->ref, obj->flags, obj->sent
2788 );
2789 }
2790 check_object_shadow(obj, sh);
2791 obj->sent = new_sent;
2792 sh->sent = new_sent;
2793 }
2794
2795 #endif /* CHECK_OBJECT_REF */
2796 /*-------------------------------------------------------------------------*/
2797 static void
remove_object(object_t * ob,object_shadow_t * sh)2798 remove_object (object_t *ob
2799 #ifdef CHECK_OBJECT_REF
2800 , object_shadow_t *sh
2801 #endif /* CHECK_OBJECT_REF */
2802 )
2803
2804 /* This function is called from outside any execution thread to finally
2805 * remove object <ob>. <ob> must have been unlinked from all object lists
2806 * already (but the associated reference count must still exist).
2807 *
2808 * The function frees all variables and remaining sentences in the object.
2809 * If then only one reference (from the original object list) remains, the
2810 * object is freed immediately with a call to free_object(). If more
2811 * references exist, the object is linked into the destructed_objs list
2812 * for freeing at a future date.
2813 *
2814 * The object structure and the program will be freed as soon as there
2815 * are no further references to the object (the program will remain behind
2816 * in case it was inherited).
2817 * TODO: Distinguish data- and inheritance references?
2818 */
2819
2820 {
2821 sentence_t *sent;
2822
2823 #ifdef CHECK_OBJECT_REF
2824 check_object_shadow(ob, sh);
2825 #endif
2826 if (d_flag > 1)
2827 {
2828 debug_message("%s remove_object: object %s (ref %"PRIdPINT")\n"
2829 , time_stamp(), get_txt(ob->name), ob->ref);
2830 }
2831
2832 if (O_IS_INTERACTIVE(ob))
2833 remove_interactive(ob, MY_FALSE);
2834
2835 /* If this is a blueprint object, NULL out the pointer in the program
2836 * to remove the extraneous reference.
2837 */
2838 if (ob->prog->blueprint == ob)
2839 {
2840 ob->prog->blueprint = NULL;
2841 remove_prog_swap(ob->prog, MY_TRUE);
2842 free_object(ob, "remove_object: blueprint reference");
2843 }
2844
2845 /* We must deallocate variables here, not in 'free_object()'.
2846 * That is because one of the local variables may point to this object,
2847 * and deallocation of this pointer will also decrease the reference
2848 * count of this object. Otherwise, an object with a variable pointing
2849 * to itself would never be freed.
2850 * Just in case the program in this object would continue to
2851 * execute, change string and object variables into the number 0.
2852 */
2853 if (ob->prog->num_variables > 0)
2854 {
2855 /* Deallocate variables in this object.
2856 */
2857 int i;
2858 for (i = 0; i < ob->prog->num_variables; i++)
2859 {
2860 free_svalue(&ob->variables[i]);
2861 put_number(ob->variables+i, 0);
2862 }
2863 xfree(ob->variables);
2864 }
2865 #ifdef DEBUG
2866 else if (ob->variables != NULL)
2867 {
2868 debug_message("%s Warning: Object w/o variables, but variable block "
2869 "at %p\n", time_stamp(), ob->variables);
2870 }
2871 #endif
2872
2873 /* This should be here to avoid using up memory as long as the object
2874 * isn't released. It must be here because gcollect doesn't expect
2875 * sentences in destructed objects.
2876 */
2877 if ( NULL != (sent = ob->sent) )
2878 {
2879 sentence_t *next;
2880 do {
2881
2882 next = sent->next;
2883 if (sent->type == SENT_SHADOW)
2884 free_shadow_sent((shadow_t *)sent);
2885 else
2886 free_action_sent((action_t *)sent);
2887 } while ( NULL != (sent = next) );
2888 ob->sent = NULL;
2889 #ifdef CHECK_OBJECT_REF
2890 sh->sent = NULL;
2891 #endif /* CHECK_OBJECT_REF */
2892 }
2893
2894 /* Either free the object, or link it up for future freeing. */
2895 if (ob->ref <= 1)
2896 {
2897 free_object(ob, "destruct_object");
2898 #ifdef CHECK_OBJECT_REF
2899 xfree(sh);
2900 #endif /* CHECK_OBJECT_REF */
2901 }
2902 else
2903 {
2904 if (destructed_objs != NULL)
2905 destructed_objs->prev_all = ob;
2906 ob->next_all = destructed_objs;
2907 destructed_objs = ob;
2908 ob->prev_all = NULL;
2909 num_destructed++;
2910 #ifdef CHECK_OBJECT_REF
2911 sh->next = destructed_obj_shadows;
2912 destructed_obj_shadows = sh;
2913 #endif /* CHECK_OBJECT_REF */
2914 }
2915 } /* remove_object() */
2916
2917 /*-------------------------------------------------------------------------*/
2918 void
handle_newly_destructed_objects(void)2919 handle_newly_destructed_objects (void)
2920
2921 /* Finish up all newly destructed objects kept in the newly_destructed_objs
2922 * list: deallocate as many associated resources and, if there are
2923 * more than one references to the object, put it into the destructed_objs list.
2924 */
2925
2926 {
2927 while (newly_destructed_objs)
2928 {
2929 object_t *ob = newly_destructed_objs;
2930
2931 #ifdef CHECK_OBJECT_REF
2932 object_t *next_ob = ob->next_all;
2933 object_shadow_t *sh = newly_destructed_obj_shadows;
2934 object_shadow_t *next_sh = sh->next;
2935 #else
2936 newly_destructed_objs = ob->next_all;
2937 #endif /* CHECK_OBJECT_REF */
2938
2939 #ifdef DEBUG
2940 if (!(ob->flags & O_DESTRUCTED))
2941 fatal("Non-destructed object %p '%s' in list of destructed objects.\n"
2942 , ob, ob->name ? get_txt(ob->name) : "<null>"
2943 );
2944 #endif
2945 #ifdef CHECK_OBJECT_REF
2946 remove_object(ob, sh);
2947 newly_destructed_objs = next_ob;
2948 newly_destructed_obj_shadows = next_sh;
2949 #else
2950 remove_object(ob);
2951 #endif /* CHECK_OBJECT_REF */
2952 num_newly_destructed--;
2953 }
2954 } /* handle_newly_destructed_objects() */
2955
2956 /*-------------------------------------------------------------------------*/
2957 void
remove_destructed_objects(Bool force)2958 remove_destructed_objects (Bool force)
2959
2960 /* Scan the list of destructed objects and free those with no references
2961 * remaining.
2962 * If <force> is FALSE, the call immediately returns if the flag
2963 * <dest_last_ref_gone> (in object.c) is FALSE - this flag is set by
2964 * free_object() if all but one reference to a destructed object is gone.
2965 * If <force> is TRUE, the scan takes place unconditionally (this is used by
2966 * the GC).
2967 */
2968
2969 {
2970 object_t *ob;
2971 #ifdef CHECK_OBJECT_REF
2972 object_shadow_t *sh = destructed_obj_shadows;
2973 object_shadow_t *prev = NULL;
2974 #endif /* CHECK_OBJECT_REF */
2975
2976 if (!force && !dest_last_ref_gone)
2977 return;
2978
2979 dest_last_ref_gone = MY_FALSE;
2980
2981 for (ob = destructed_objs; ob != NULL; )
2982 {
2983 object_t *victim;
2984
2985 #ifdef CHECK_OBJECT_REF
2986 check_object_shadow(ob, sh);
2987 #endif /* CHECK_OBJECT_REF */
2988 /* Check if only the list reference remains.
2989 * If not, go to the next object.
2990 */
2991 if (ob->ref > 1)
2992 {
2993 ob = ob->next_all;
2994 #ifdef CHECK_OBJECT_REF
2995 prev = sh;
2996 sh = sh->next;
2997 #endif /* CHECK_OBJECT_REF */
2998 continue;
2999 }
3000
3001 /* This object can be freed - remove it from the list */
3002 victim = ob;
3003 if (ob->prev_all != NULL)
3004 ob->prev_all->next_all = ob->next_all;
3005 if (ob->next_all != NULL)
3006 ob->next_all->prev_all = ob->prev_all;
3007 if (destructed_objs == ob)
3008 destructed_objs = ob->next_all;
3009 ob = ob->next_all;
3010
3011 free_object(victim, "remove_destructed_objects");
3012 num_destructed--;
3013 #ifdef CHECK_OBJECT_REF
3014 {
3015 object_shadow_t * next = sh->next;
3016 if (prev == NULL)
3017 {
3018 destructed_obj_shadows = next;
3019 }
3020 else
3021 {
3022 prev->next = next;
3023 }
3024 xfree(sh);
3025 sh = next;
3026 }
3027 #endif /* CHECK_OBJECT_REF */
3028 }
3029 } /* remove_destructed_objects() */
3030
3031 /*-------------------------------------------------------------------------*/
3032 static INLINE shadow_t *
new_shadow_sent(void)3033 new_shadow_sent(void)
3034
3035 /* Allocate a new empty shadow sentence and return it.
3036 */
3037
3038 {
3039 shadow_t *p;
3040
3041 xallocate(p, sizeof *p, "new shadow sentence");
3042 alloc_shadow_sent++;
3043
3044 p->sent.type = SENT_SHADOW;
3045 p->shadowing = NULL;
3046 p->shadowed_by = NULL;
3047 p->ip = NULL;
3048 return p;
3049 } /* new_shadow_sent() */
3050
3051 /*-------------------------------------------------------------------------*/
3052 static void
free_shadow_sent(shadow_t * p)3053 free_shadow_sent (shadow_t *p)
3054
3055 /* Free the shadow sentence <p>.
3056 */
3057
3058 {
3059 #ifdef DEBUG
3060 if (SENT_SHADOW != p->sent.type)
3061 fatal("free_shadow_sent() received non-shadow sent type %d\n"
3062 , p->sent.type);
3063 #endif
3064
3065 xfree(p);
3066 alloc_shadow_sent--;
3067 } /* free_shadow_sent() */
3068
3069 /*-------------------------------------------------------------------------*/
3070 void
check_shadow_sent(object_t * ob)3071 check_shadow_sent (object_t *ob)
3072
3073 /* Check if object <ob> has a shadow sentence and really needs it.
3074 * If yes and no, the sentence is removed.
3075 */
3076
3077 {
3078 if (ob->flags & O_SHADOW)
3079 {
3080 shadow_t *sh;
3081
3082 sh = O_GET_SHADOW(ob);
3083
3084 if (!sh->ip
3085 && !sh->shadowing
3086 && !sh->shadowed_by
3087 )
3088 {
3089 #ifdef CHECK_OBJECT_REF
3090 update_object_sent(ob, sh->sent.next);
3091 #else
3092 ob->sent = sh->sent.next;
3093 #endif /* CHECK_OBJECT_REF */
3094 free_shadow_sent(sh);
3095 ob->flags &= ~O_SHADOW;
3096 }
3097 }
3098 } /* check_shadow_sent() */
3099
3100 /*-------------------------------------------------------------------------*/
3101 void
assert_shadow_sent(object_t * ob)3102 assert_shadow_sent (object_t *ob)
3103
3104 /* Make sure that object <ob> has a shadow sentence.
3105 */
3106
3107 {
3108 if (!(ob->flags & O_SHADOW))
3109 {
3110 shadow_t *sh;
3111
3112 sh = new_shadow_sent();
3113 sh->sent.next = ob->sent;
3114 #ifdef CHECK_OBJECT_REF
3115 update_object_sent(ob, (sentence_t *)sh);
3116 #else
3117 ob->sent = (sentence_t *)sh;
3118 #endif /* CHECK_OBJECT_REF */
3119 ob->flags |= O_SHADOW;
3120 }
3121 } /* assert_shadow_sent() */
3122
3123 /*-------------------------------------------------------------------------*/
3124 Bool
status_parse(strbuf_t * sbuf,char * buff)3125 status_parse (strbuf_t * sbuf, char * buff)
3126
3127 /* Parse the status request in <buff> and if recognized, dump the
3128 * data into the stringbuffer <sbuf>.
3129 *
3130 * Return TRUE if the request was recognised, and FALSE otherwise.
3131 *
3132 * The function is called from actions:special_parse() to implement
3133 * the hardcoded commands, and from the efun debug_info().
3134 */
3135
3136 {
3137 if (sbuf)
3138 strbuf_zero(sbuf);
3139
3140 if (!buff || *buff == 0 || strcmp(buff, "tables") == 0)
3141 {
3142 size_t tot, res;
3143 Bool verbose = MY_FALSE;
3144
3145 if (strcmp(buff, "tables") == 0)
3146 verbose = MY_TRUE;
3147
3148 res = 0;
3149 if (reserved_user_area)
3150 res = reserved_user_size;
3151 if (reserved_master_area)
3152 res += reserved_master_size;
3153 if (reserved_system_area)
3154 res += reserved_system_size;
3155 if (!verbose)
3156 {
3157 strbuf_addf(sbuf, "Actions:\t\t\t%8"PRIdPINT" %9"PRIdPINT"\n"
3158 , alloc_action_sent
3159 , alloc_action_sent * sizeof (action_t));
3160 strbuf_addf(sbuf, "Shadows:\t\t\t%8"PRIdPINT" %9"PRIdPINT"\n"
3161 , alloc_shadow_sent
3162 , alloc_shadow_sent * sizeof (shadow_t));
3163 strbuf_addf(sbuf, "Objects:\t\t\t%8ld %9ld (%ld destructed;"
3164 " %"PRIdMPINT" swapped: %"PRIdMPINT" Kbytes)\n"
3165 , tot_alloc_object, tot_alloc_object_size
3166 , num_destructed
3167 , num_vb_swapped, total_vb_bytes_swapped / 1024);
3168 strbuf_addf(sbuf, "Prog blocks:\t\t\t%8"PRIdMPINT" %9"PRIdMPINT
3169 " (%"PRIdMPINT" swapped: %"PRIdMPINT" Kbytes)\n"
3170 , total_num_prog_blocks + num_swapped - num_unswapped
3171 , total_prog_block_size + total_bytes_swapped
3172 - total_bytes_unswapped
3173 , num_swapped - num_unswapped
3174 , (total_bytes_swapped - total_bytes_unswapped) / 1024);
3175 strbuf_addf(sbuf, "Arrays:\t\t\t\t%8ld %9ld\n"
3176 , (long)num_arrays, total_array_size() );
3177 strbuf_addf(sbuf, "Mappings:\t\t\t%8"PRIdMPINT" %9"PRIdMPINT
3178 " (%"PRIdMPINT" hybrid, %"PRIdMPINT" hash)\n"
3179 , num_mappings, total_mapping_size()
3180 , num_dirty_mappings, num_hash_mappings
3181 );
3182 strbuf_addf(sbuf, "Memory reserved:\t\t\t %9zu\n", res);
3183 }
3184 if (verbose) {
3185 /* TODO: Add these numbers to the debug_info statistics. */
3186 strbuf_add(sbuf, "\nVM Execution:\n");
3187 strbuf_add(sbuf, "-------------\n");
3188 strbuf_addf(sbuf
3189 , "Last: %10lu ticks, %3ld.%06ld s\n"
3190 "Average: %10.0lf ticks, %10.6lf s\n"
3191 , last_total_evalcost
3192 , last_eval_duration.tv_sec, (long)last_eval_duration.tv_usec
3193 , stat_total_evalcost.weighted_avg
3194 , stat_eval_duration.weighted_avg / 1000000.0
3195 );
3196 strbuf_addf(sbuf
3197 , "Load: %.2lf cmds/s, %.2lf comp lines/s\n"
3198 , stat_load.weighted_avg
3199 , stat_compile.weighted_avg
3200 );
3201
3202 #ifdef COMM_STAT
3203 strbuf_add(sbuf, "\nNetwork IO:\n");
3204 strbuf_add(sbuf, "-----------\n");
3205 strbuf_addf(sbuf
3206 , "In: Packets: %10lu - Sum: %10lu - "
3207 "Average packet size: %7.2f\n"
3208 , inet_packets_in
3209 , inet_volume_in
3210 , inet_packets_in ? (float)inet_volume_in/(float)inet_packets_in : 0.0
3211 );
3212 strbuf_addf(sbuf
3213 , "Out: Packets: %10lu - Sum: %10lu - "
3214 "Average packet size: %7.2f\n"
3215 " Calls to add_message: %lu\n"
3216 , inet_packets
3217 , inet_volume
3218 , inet_packets ? (float)inet_volume/(float)inet_packets : 0.0
3219 , add_message_calls
3220 );
3221 #endif
3222 #ifdef APPLY_CACHE_STAT
3223 strbuf_add(sbuf, "\nApply Cache:\n");
3224 strbuf_add(sbuf, "------------\n");
3225 strbuf_addf(sbuf
3226 , "Calls to apply_low: %10"PRIuPINT"\n"
3227 "Cache hits: %10"PRIuPINT" (%.2f%%)\n"
3228 , (apply_cache_hit+apply_cache_miss)
3229 , apply_cache_hit
3230 , 100.*(float)apply_cache_hit/
3231 (float)(apply_cache_hit+apply_cache_miss) );
3232 #endif
3233 }
3234 tot = alloc_action_sent * sizeof(action_t);
3235 tot += alloc_shadow_sent * sizeof(shadow_t);
3236 tot += total_prog_block_size;
3237 tot += total_array_size();
3238 tot += tot_alloc_object_size;
3239 if (verbose)
3240 {
3241 #ifdef DEBUG
3242 unsigned long count;
3243 object_t *ob;
3244 #endif
3245
3246 strbuf_add(sbuf, "\nObject status:\n");
3247 strbuf_add(sbuf, "--------------\n");
3248 strbuf_addf(sbuf, "Objects total:\t\t\t %8ld\n"
3249 , tot_alloc_object);
3250 #ifndef DEBUG
3251 strbuf_addf(sbuf, "Objects in list:\t\t %8lu\n"
3252 , (unsigned long)num_listed_objs);
3253 strbuf_addf(sbuf, "Objects newly destructed:\t\t %8ld\n"
3254 , num_newly_destructed);
3255 strbuf_addf(sbuf, "Objects destructed:\t\t %8ld\n"
3256 , num_destructed);
3257 #else
3258 for (count = 0, ob = obj_list; ob != NULL; ob = ob->next_all)
3259 count++;
3260 if (count != (long)num_listed_objs)
3261 {
3262 debug_message("DEBUG: num_listed_objs mismatch: listed %lu, counted %lu\n"
3263 , (unsigned long)num_listed_objs, count);
3264 strbuf_addf(sbuf, "Objects in list:\t\t %8lu (counted %lu)\n"
3265 , (unsigned long)num_listed_objs, count);
3266 }
3267 else
3268 strbuf_addf(sbuf, "Objects in list:\t\t %8lu\n"
3269 , (unsigned long)num_listed_objs);
3270 for (count = 0, ob = newly_destructed_objs; ob != NULL; ob = ob->next_all)
3271 count++;
3272 if (count != num_newly_destructed)
3273 {
3274 debug_message("DEBUG: num_newly_destructed mismatch: listed %ld, counted %lu\n"
3275 , num_newly_destructed, count);
3276 strbuf_addf(sbuf, "Objects newly destructed:\t\t %8ld (counted %lu)\n"
3277 , num_newly_destructed, count);
3278 }
3279 else
3280 strbuf_addf(sbuf, "Objects newly destructed:\t %8ld\n"
3281 , num_newly_destructed);
3282 for (count = 0, ob = destructed_objs; ob != NULL; ob = ob->next_all)
3283 count++;
3284 if (count != num_destructed)
3285 {
3286 debug_message("DEBUG: num_destructed mismatch: listed %ld, counted %lu\n"
3287 , num_destructed, count);
3288 strbuf_addf(sbuf, "Objects destructed:\t\t %8ld (counted %lu)\n"
3289 , num_destructed, count);
3290 }
3291 else
3292 strbuf_addf(sbuf, "Objects destructed:\t\t %8ld\n"
3293 , num_destructed);
3294 #endif
3295
3296 strbuf_addf(sbuf, "Objects processed in last cycle: "
3297 "%8lu (%5.1lf%% - avg. %5.1lf%%)\n"
3298 , (unsigned long)num_last_processed
3299 , (float)num_last_processed / (float)num_listed_objs * 100.0
3300 , 100.0 * relate_statistics(stat_last_processed, stat_in_list)
3301 );
3302 #ifdef NEW_CLEANUP
3303 strbuf_addf(sbuf, "Objects data-cleaned in last cycle: "
3304 "%5lu (%5.1lf%% - avg. %5.1lf : %5.1lf%%)\n"
3305 , (unsigned long)num_last_data_cleaned
3306 , (double)num_last_data_cleaned / (double)num_listed_objs * 100.0
3307 , stat_last_data_cleaned.weighted_avg
3308 , 100.0 * relate_statistics(stat_last_data_cleaned, stat_in_list)
3309 );
3310 #endif
3311 }
3312 tot += show_otable_status(sbuf, verbose);
3313 tot += heart_beat_status(sbuf, verbose);
3314 tot += add_string_status(sbuf, verbose);
3315 tot += call_out_status(sbuf, verbose);
3316 tot += total_mapping_size();
3317 #ifdef USE_STRUCTS
3318 tot += total_struct_size(sbuf, verbose);
3319 #endif
3320 tot += rxcache_status(sbuf, verbose);
3321 if (verbose)
3322 {
3323 strbuf_add(sbuf, "\nOther:\n");
3324 strbuf_add(sbuf, "------\n");
3325 }
3326 tot += show_lexer_status(sbuf, verbose);
3327 tot += show_comm_status(sbuf, verbose);
3328 if (!verbose)
3329 {
3330 size_t other;
3331
3332 other = wiz_list_size();
3333 other += swap_overhead();
3334 other += num_simul_efun * sizeof(function_t);
3335 other += interpreter_overhead();
3336 strbuf_addf(sbuf, "Other structures\t\t\t %9zu\n", other);
3337 tot += other;
3338 }
3339 tot += mb_status(sbuf, verbose);
3340 tot += res;
3341
3342 if (!verbose) {
3343 strbuf_add(sbuf, "\t\t\t\t\t ---------\n");
3344 strbuf_add(sbuf, "Total:\t\t\t\t\t ");
3345 strbuf_addf(sbuf, "%9zu\n", tot);
3346 }
3347 return MY_TRUE;
3348 }
3349
3350 if (strcmp(buff, "swap") == 0)
3351 {
3352 swap_status(sbuf);
3353 return MY_TRUE;
3354 }
3355
3356 if (strcmp(buff, "malloc") == 0) {
3357 mem_dump_data(sbuf);
3358 return MY_TRUE;
3359 }
3360
3361 if (strcmp(buff, "malloc extstats") == 0) {
3362 mem_dump_extdata(sbuf);
3363 return MY_TRUE;
3364 }
3365
3366 return MY_FALSE;
3367 } /* status_parse() */
3368
3369 /*-------------------------------------------------------------------------*/
3370 void
dinfo_data_status(svalue_t * svp,int value)3371 dinfo_data_status (svalue_t *svp, int value)
3372
3373 /* Fill in the "status" data for debug_info(DINFO_DATA, DID_STATUS)
3374 * into the svalue-block <svp>.
3375 * If <value> is -1, <svp> points indeed to a value block; other it is
3376 * the index of the desired value and <svp> points to a single svalue.
3377 */
3378
3379 {
3380 STORE_DOUBLE_USED;
3381
3382 #define ST_NUMBER(which,code) \
3383 if (value == -1) svp[which].u.number = code; \
3384 else if (value == which) svp->u.number = code
3385
3386 #define ST_DOUBLE(which,code) \
3387 if (value == -1) { \
3388 svp[which].type = T_FLOAT; \
3389 STORE_DOUBLE(svp+which, code); \
3390 } else if (value == which) { \
3391 svp->type = T_FLOAT; \
3392 STORE_DOUBLE(svp, code); \
3393 }
3394
3395 ST_NUMBER(DID_ST_ACTIONS, alloc_action_sent);
3396 ST_NUMBER(DID_ST_ACTIONS_SIZE, alloc_action_sent * sizeof (action_t));
3397 ST_NUMBER(DID_ST_SHADOWS, alloc_shadow_sent);
3398 ST_NUMBER(DID_ST_SHADOWS_SIZE, alloc_shadow_sent * sizeof (shadow_t));
3399
3400 ST_NUMBER(DID_ST_OBJECTS, tot_alloc_object);
3401 ST_NUMBER(DID_ST_OBJECTS_SIZE, tot_alloc_object_size);
3402 ST_NUMBER(DID_ST_OBJECTS_SWAPPED, num_vb_swapped);
3403 ST_NUMBER(DID_ST_OBJECTS_SWAP_SIZE, total_vb_bytes_swapped);
3404 ST_NUMBER(DID_ST_OBJECTS_LIST, num_listed_objs);
3405 ST_NUMBER(DID_ST_OBJECTS_NEWLY_DEST, num_newly_destructed);
3406 ST_NUMBER(DID_ST_OBJECTS_DESTRUCTED, num_destructed);
3407 ST_NUMBER(DID_ST_OBJECTS_PROCESSED, num_last_processed);
3408 ST_DOUBLE(DID_ST_OBJECTS_AVG_PROC, relate_statistics(stat_last_processed, stat_in_list));
3409 /* TODO: Maybe add number of objects data cleaned here as well. */
3410
3411 ST_NUMBER(DID_ST_ARRAYS, num_arrays);
3412 ST_NUMBER(DID_ST_ARRAYS_SIZE, total_array_size());
3413
3414 ST_NUMBER(DID_ST_MAPPINGS, num_mappings);
3415 ST_NUMBER(DID_ST_MAPPINGS_SIZE, total_mapping_size());
3416 ST_NUMBER(DID_ST_HYBRID_MAPPINGS, num_dirty_mappings);
3417 ST_NUMBER(DID_ST_HASH_MAPPINGS, num_hash_mappings);
3418
3419 ST_NUMBER(DID_ST_PROGS, total_num_prog_blocks + num_swapped
3420 - num_unswapped);
3421 ST_NUMBER(DID_ST_PROGS_SIZE, total_prog_block_size + total_bytes_swapped
3422 - total_bytes_unswapped);
3423 ST_NUMBER(DID_ST_PROGS_SWAPPED, num_swapped - num_unswapped);
3424 ST_NUMBER(DID_ST_PROGS_SWAP_SIZE, total_bytes_swapped - total_bytes_unswapped);
3425
3426 ST_NUMBER(DID_ST_USER_RESERVE, reserved_user_size);
3427 ST_NUMBER(DID_ST_MASTER_RESERVE, reserved_master_size);
3428 ST_NUMBER(DID_ST_SYSTEM_RESERVE, reserved_system_size);
3429
3430 #ifdef COMM_STAT
3431 ST_NUMBER(DID_ST_ADD_MESSAGE, add_message_calls);
3432 ST_NUMBER(DID_ST_PACKETS, inet_packets);
3433 ST_NUMBER(DID_ST_PACKET_SIZE, inet_volume);
3434 ST_NUMBER(DID_ST_PACKETS_IN, inet_packets_in);
3435 ST_NUMBER(DID_ST_PACKET_SIZE_IN, inet_volume_in);
3436 #else
3437 ST_NUMBER(DID_ST_ADD_MESSAGE, -1);
3438 ST_NUMBER(DID_ST_PACKETS, -1);
3439 ST_NUMBER(DID_ST_PACKET_SIZE, -1);
3440 ST_NUMBER(DID_ST_PACKETS_IN, -1);
3441 ST_NUMBER(DID_ST_PACKET_SIZE_IN, -1);
3442 #endif
3443 #ifdef APPLY_CACHE_STAT
3444 ST_NUMBER(DID_ST_APPLY, apply_cache_hit+apply_cache_miss);
3445 ST_NUMBER(DID_ST_APPLY_HITS, apply_cache_hit);
3446 #else
3447 ST_NUMBER(DID_ST_APPLY, -1);
3448 ST_NUMBER(DID_ST_APPLY_HITS, -1);
3449 #endif
3450
3451 #undef ST_NUMBER
3452 #undef ST_DOUBLE
3453 } /* dinfo_data_status() */
3454
3455 /*-------------------------------------------------------------------------*/
3456 string_t *
check_valid_path(string_t * path,object_t * caller,string_t * call_fun,Bool writeflg)3457 check_valid_path (string_t *path, object_t *caller, string_t* call_fun, Bool writeflg)
3458
3459 /* Object <caller> will read resp. write (<writeflg>) the file <path>
3460 * for the efun <call_fun>.
3461 *
3462 * Check the validity of the operation by calling master:valid_read() resp.
3463 * valid_write().
3464 *
3465 * If the operation is valid, the path to use is returned (always without
3466 * leading '/', the path "/" will be returned as ".").
3467 *
3468 * The result string has its own reference, but may be <path> again.
3469 *
3470 * If the operation is invalid, NULL is returned.
3471 */
3472
3473 {
3474 svalue_t *v;
3475 wiz_list_t *eff_user;
3476
3477 if (path)
3478 push_ref_string(inter_sp, path);
3479 else
3480 push_number(inter_sp, 0);
3481
3482 if ( NULL != (eff_user = caller->eff_user) && NULL != eff_user->name)
3483 push_ref_string(inter_sp, eff_user->name);
3484 else
3485 push_number(inter_sp, 0);
3486
3487 push_ref_string(inter_sp, call_fun);
3488 push_ref_valid_object(inter_sp, caller, "check_valid_path");
3489 if (writeflg)
3490 v = apply_master(STR_VALID_WRITE, 4);
3491 else
3492 v = apply_master(STR_VALID_READ, 4);
3493
3494 if (!v || (v->type == T_NUMBER && v->u.number == 0))
3495 return NULL;
3496
3497 if (v->type != T_STRING)
3498 {
3499 if (!path)
3500 {
3501 debug_message("%s master returned bogus filename\n", time_stamp());
3502 return NULL;
3503 }
3504 (void)ref_mstring(path);
3505 }
3506 else if (v->u.str == path)
3507 {
3508 (void)ref_mstring(path);
3509 }
3510 else
3511 {
3512 path = ref_mstring(v->u.str);
3513 }
3514
3515 if (get_txt(path)[0] == '/')
3516 {
3517 string_t *npath;
3518 memsafe(npath = del_slash(path), mstrsize(path)-1
3519 , "path for file operation");
3520 free_mstring(path);
3521 path = npath;
3522 }
3523
3524 /* The string "/" will be converted to "." */
3525 if (mstreq(path, STR_EMPTY))
3526 {
3527 free_mstring(path);
3528 path = ref_mstring(STR_PERIOD);
3529 }
3530
3531 if (legal_path(get_txt(path)))
3532 {
3533 return path;
3534 }
3535
3536 /* Push the path onto the VM stack so that errorf() can free it */
3537 push_string(inter_sp, path);
3538 errorf("Illegal path '%s' for %s() by %s\n", get_txt(path), get_txt(call_fun)
3539 , get_txt(caller->name));
3540 return NULL;
3541 } /* check_valid_path() */
3542
3543 /*-------------------------------------------------------------------------*/
3544 void
init_empty_callback(callback_t * cb)3545 init_empty_callback (callback_t *cb)
3546
3547 /* Initialize *<cb> to be an empty initialized callback.
3548 * Use this to initialize callback structures which might be freed before
3549 * completely filled in.
3550 */
3551
3552 {
3553 cb->num_arg = 0;
3554 cb->is_lambda = MY_FALSE;
3555 cb->function.named.ob = NULL;
3556 cb->function.named.name = NULL;
3557 } /* init_empty_callback() */
3558
3559 /*-------------------------------------------------------------------------*/
3560 static INLINE void
free_callback_args(callback_t * cb)3561 free_callback_args (callback_t *cb)
3562
3563 /* Free the function arguments in the callback <cb>.
3564 */
3565
3566 {
3567 svalue_t *dest;
3568 int nargs;
3569
3570 nargs = cb->num_arg;
3571
3572 if (nargs == 1)
3573 {
3574 if (cb->arg.type != T_INVALID)
3575 free_svalue(&(cb->arg));
3576 }
3577 else if (nargs > 1 && !cb->arg.x.extern_args)
3578 {
3579 dest = cb->arg.u.lvalue;
3580
3581 while (--nargs >= 0)
3582 if (dest->type != T_INVALID)
3583 free_svalue(dest++);
3584
3585 xfree(cb->arg.u.lvalue);
3586 }
3587
3588 cb->arg.type = T_INVALID;
3589 cb->num_arg = 0;
3590 } /* free_callback_args() */
3591
3592 /*-------------------------------------------------------------------------*/
3593 void
free_callback(callback_t * cb)3594 free_callback (callback_t *cb)
3595
3596 /* Free the data and references held by callback structure <cb>.
3597 * The structure itself remains because usually it is embedded within
3598 * another structure.
3599 *
3600 * Repeated calls for the same callback structure are legal.
3601 */
3602
3603 {
3604 if (cb->is_lambda && cb->function.lambda.type != T_INVALID)
3605 {
3606 free_svalue(&(cb->function.lambda));
3607 cb->function.lambda.type = T_INVALID;
3608 }
3609 else if (!(cb->is_lambda))
3610 {
3611 if (cb->function.named.ob)
3612 free_object(cb->function.named.ob, "free_callback");
3613 if (cb->function.named.name)
3614 free_mstring(cb->function.named.name);
3615 cb->function.named.ob = NULL;
3616 cb->function.named.name = NULL;
3617 }
3618
3619 free_callback_args(cb);
3620 } /* free_callback() */
3621
3622 /*-------------------------------------------------------------------------*/
3623 static INLINE int
setup_callback_args(callback_t * cb,int nargs,svalue_t * args,Bool delayed_callback)3624 setup_callback_args (callback_t *cb, int nargs, svalue_t * args
3625 , Bool delayed_callback)
3626
3627 /* Setup the function arguments in the callback <cb> to hold the <nargs>
3628 * arguments starting from <args>. If <delayed_callback> is FALSE,
3629 * the callback will happen within the current LPC cycle: no argument may be
3630 * a protected lvalue, but normal lvalues are ok. If TRUE, the callback
3631 * will happen at a later time: protected lvalues are ok, but not normal ones.
3632 *
3633 * The arguments are transferred into the callback structure.
3634 *
3635 * Result is -1 on success, or, when encountering an illegal argument,
3636 * the index of the faulty argument (but even then all caller arguments
3637 * have been transferred or freed).
3638 *
3639 * TODO: It should be possible to accept protected lvalues by careful
3640 * TODO:: juggling of the protector structures. That, or rewriting the
3641 * TODO:: lvalue system.
3642 */
3643
3644 {
3645 svalue_t *dest;
3646
3647 cb->num_arg = nargs;
3648
3649 if (nargs < 1)
3650 {
3651 cb->arg.type = T_INVALID;
3652 cb->num_arg = 0;
3653 }
3654 else
3655 {
3656 /* Transfer the arguments into the callback structure */
3657
3658 if (nargs > 1)
3659 {
3660 xallocate(dest, sizeof(*dest) * nargs, "callback structure");
3661 cb->arg.type = T_LVALUE;
3662 cb->arg.u.lvalue = dest;
3663 cb->arg.x.extern_args = MY_FALSE;
3664 }
3665 else
3666 dest = &(cb->arg);
3667
3668 while (--nargs >= 0)
3669 {
3670 Bool dontHandle = MY_FALSE;
3671
3672 if (args->type == T_LVALUE)
3673 {
3674 /* Check if we are allowed to handle the lvalues. */
3675 Bool isProtected
3676 = ( args->u.lvalue->type == T_PROTECTED_CHAR_LVALUE
3677 || args->u.lvalue->type == T_PROTECTED_STRING_RANGE_LVALUE
3678 || args->u.lvalue->type == T_PROTECTED_POINTER_RANGE_LVALUE
3679 || args->u.lvalue->type == T_PROTECTED_LVALUE
3680 );
3681
3682 dontHandle = ( delayed_callback && !isProtected)
3683 || (!delayed_callback && isProtected)
3684 ;
3685 }
3686
3687 if (dontHandle)
3688 {
3689 /* We don't handle the lvalue - abort the process.
3690 * But to do that, we first have to free all
3691 * remaining arguments from the caller.
3692 */
3693
3694 int error_index = cb->num_arg - nargs - 1;
3695
3696 do {
3697 free_svalue(args++);
3698 (dest++)->type = T_INVALID;
3699 } while (--nargs >= 0);
3700
3701 free_callback_args(cb);
3702
3703 return error_index;
3704 }
3705
3706 transfer_svalue_no_free(dest++, args++);
3707 }
3708 }
3709
3710 /* Success */
3711 return -1;
3712 } /* setup_callback_args() */
3713
3714 /*-------------------------------------------------------------------------*/
3715 int
setup_function_callback(callback_t * cb,object_t * ob,string_t * fun,int nargs,svalue_t * args,Bool delayed_callback)3716 setup_function_callback ( callback_t *cb, object_t * ob, string_t * fun
3717 , int nargs, svalue_t * args, Bool delayed_callback)
3718
3719 /* Setup the empty/uninitialized callback <cb> to hold a function
3720 * call to <ob>:<fun> with the <nargs> arguments starting from <args>.
3721 * If <delayed_callback> is FALSE, the callback will happen within the current
3722 * LPC cycle: no argument may be a protected lvalue, but normal lvalues are
3723 * ok. If TRUE, the callback will happen at a later time: protected lvalues
3724 * are ok, but not normal ones.
3725 *
3726 * Both <ob> and <fun> are copied from the caller, but the arguments are
3727 * adopted (taken away from the caller).
3728 *
3729 * Result is -1 on success, or, when encountering an illegal argument,
3730 * the index of the faulty argument (but even then all caller arguments
3731 * have been transferred or freed).
3732 */
3733
3734 {
3735 int error_index;
3736
3737 cb->is_lambda = MY_FALSE;
3738 cb->function.named.name = make_tabled_from(fun); /* for faster apply()s */
3739 cb->function.named.ob = ref_object(ob, "callback");
3740
3741 error_index = setup_callback_args(cb, nargs, args, delayed_callback);
3742 if (error_index >= 0)
3743 {
3744 free_object(cb->function.named.ob, "callback");
3745 free_mstring(cb->function.named.name);
3746 cb->function.named.ob = NULL;
3747 cb->function.named.name = NULL;
3748 }
3749
3750 return error_index;
3751 } /* setup_function_callback() */
3752
3753 /*-------------------------------------------------------------------------*/
3754 int
setup_closure_callback(callback_t * cb,svalue_t * cl,int nargs,svalue_t * args,Bool delayed_callback)3755 setup_closure_callback ( callback_t *cb, svalue_t *cl
3756 , int nargs, svalue_t * args, Bool delayed_callback)
3757
3758 /* Setup the empty/uninitialized callback <cb> to hold a closure
3759 * call to <cl> with the <nargs> arguments starting from <args>.
3760 * If <delayed_callback> is FALSE, the callback will happen within the current
3761 * LPC cycle: no argument may be a protected lvalue, but normal lvalues are
3762 * ok. If TRUE, the callback will happen at a later time: protected lvalues
3763 * are ok, but not normal ones.
3764 *
3765 * Both <cl> and the arguments are adopted (taken away from the caller).
3766 *
3767 * Result is -1 on success, or, when encountering an illegal argument,
3768 * the index of the faulty argument (but even then all caller arguments
3769 * have been transferred or freed).
3770 */
3771
3772 {
3773 int error_index = -1;
3774
3775 cb->is_lambda = MY_TRUE;
3776 transfer_svalue_no_free(&(cb->function.lambda), cl);
3777
3778 if (cb->function.lambda.x.closure_type == CLOSURE_UNBOUND_LAMBDA
3779 || cb->function.lambda.x.closure_type == CLOSURE_PRELIMINARY
3780 )
3781 {
3782 /* Uncalleable closure */
3783 error_index = 0;
3784 free_svalue(&(cb->function.lambda));
3785 cb->function.lambda.type = T_INVALID;
3786 }
3787 else
3788 {
3789 error_index = setup_callback_args(cb, nargs, args, delayed_callback);
3790 if (error_index >= 0)
3791 {
3792 free_svalue(&(cb->function.lambda));
3793 cb->function.lambda.type = T_INVALID;
3794 error_index++;
3795 }
3796 }
3797
3798 return error_index;
3799 } /* setup_closure_callback() */
3800
3801 /*-------------------------------------------------------------------------*/
3802 int
setup_efun_callback_base(callback_t * cb,svalue_t * args,int nargs,Bool bNoObj)3803 setup_efun_callback_base ( callback_t *cb, svalue_t *args, int nargs
3804 , Bool bNoObj)
3805
3806 /* Setup the empty/uninitialized callback <cb> with the <nargs>
3807 * values starting at <args>. This function is used to implement the
3808 * callbacks for efuns like map_array() and accepts these forms:
3809 *
3810 * (string fun)
3811 * (string fun, mixed extra, ...) TODO: This form is UGLY!
3812 * (closure cl, mixed extra, ...)
3813 *
3814 * If bNoObj is FALSE (the usual case), this form is also allowed:
3815 *
3816 * (string fun, string|object obj, mixed extra, ...)
3817 *
3818 * If the first argument is a string and the second neither an object
3819 * nor a string, this_object() is used as object specification. Ditto
3820 * if bNoObj is used.
3821 *
3822 * All arguments are adopted (taken away from the caller). Protected lvalues
3823 * like &(i[0]) are not allowed as 'extra' arguments.
3824 *
3825 * Result is -1 on success, or, when encountering an illegal argument,
3826 * the index of the faulty argument (but even then all caller arguments
3827 * have been transferred or freed).
3828 *
3829 * This function is #defined to two macros:
3830 *
3831 * setup_efun_callback(cb,args,nargs) -> bNoObj == FALSE
3832 * setup_efun_callback_noobj(cb,args,nargs) -> bNoObj == TRUE
3833 *
3834 * The no-object feature is to support old-fashioned efun
3835 * unique_array().
3836 */
3837
3838 {
3839 int error_index;
3840
3841 if (args[0].type == T_CLOSURE)
3842 {
3843 error_index = setup_closure_callback(cb, args, nargs-1, args+1, MY_FALSE);
3844 }
3845 else if (args[0].type == T_STRING)
3846 {
3847 object_t *ob;
3848 int first_arg;
3849
3850 first_arg = 1;
3851
3852 if (nargs > 1)
3853 {
3854 if (bNoObj)
3855 {
3856 ob = current_object;
3857 first_arg = 1;
3858 }
3859 else
3860 {
3861 if (args[1].type == T_OBJECT)
3862 {
3863 ob = args[1].u.ob;
3864 first_arg = 2;
3865 }
3866 else if (args[1].type == T_STRING)
3867 {
3868 ob = get_object(args[1].u.str);
3869 first_arg = 2;
3870 }
3871 else
3872 {
3873 /* TODO: It would be better to throw an error here */
3874 ob = current_object;
3875 first_arg = 1;
3876 }
3877 }
3878 }
3879 else
3880 ob = current_object;
3881
3882 if (ob != NULL)
3883 {
3884 error_index = setup_function_callback(cb, ob, args[0].u.str
3885 , nargs-first_arg
3886 , args+first_arg
3887 , MY_FALSE);
3888 if (error_index >= 0)
3889 error_index += first_arg;
3890 }
3891 else
3892 {
3893 /* We couldn't find an object to call, so we have
3894 * to manually prepare the error condition.
3895 */
3896 int i;
3897
3898 for (i = first_arg; i < nargs; i++)
3899 free_svalue(args+i);
3900
3901 error_index = 1;
3902 }
3903
3904 /* Free the function spec */
3905 free_svalue(args);
3906 if (first_arg > 1)
3907 free_svalue(args+1);
3908 }
3909 else
3910 {
3911 /* We couldn't find anything to call, so we have
3912 * to manually prepare the error condition.
3913 */
3914 int i;
3915
3916 for (i = 0; i < nargs; i++)
3917 free_svalue(args+i);
3918
3919 error_index = 0;
3920 }
3921
3922 return error_index;
3923 } /* setup_efun_callback_base() */
3924
3925 /*-------------------------------------------------------------------------*/
3926 void
callback_change_object(callback_t * cb,object_t * obj)3927 callback_change_object (callback_t *cb, object_t *obj)
3928
3929 /* Change the object the callback is bound to, if it is a function callback.
3930 * A new reference is added to <obj>.
3931 */
3932
3933 {
3934 object_t *old;
3935 if (cb->is_lambda)
3936 {
3937 fatal("callback_change_object(): Must not be called with a closure callback.");
3938 /* NOTREACHED */
3939 return;
3940 }
3941
3942 old = cb->function.named.ob;
3943 cb->function.named.ob = ref_object(obj, "change callback");
3944
3945 if (old)
3946 free_object(old, "change_callback");
3947 } /* callback_change_object() */
3948
3949 /*-------------------------------------------------------------------------*/
3950 object_t *
callback_object(callback_t * cb)3951 callback_object (callback_t *cb)
3952
3953 /* Return the object to call from the callback structure <cb>.
3954 * If the object is destructed, return NULL.
3955 */
3956
3957 {
3958 object_t *ob;
3959
3960 if (cb->is_lambda)
3961 ob = !CLOSURE_MALLOCED(cb->function.lambda.x.closure_type)
3962 ? cb->function.lambda.u.ob
3963 : cb->function.lambda.u.lambda->ob;
3964 else
3965 ob = cb->function.named.ob;
3966
3967 return check_object(ob);
3968 } /* callback_object() */
3969
3970 /*-------------------------------------------------------------------------*/
3971 svalue_t *
execute_callback(callback_t * cb,int nargs,Bool keep,Bool toplevel)3972 execute_callback (callback_t *cb, int nargs, Bool keep, Bool toplevel)
3973
3974 /* Call the callback <cb> with the <nargs> arguments already pushed
3975 * onto the stack. Result is a pointer to a static area with the
3976 * result from the call.
3977 *
3978 * If an error occurs (the object to call has been destructed or can't
3979 * be swapped in), NULL is returned.
3980 *
3981 * If <keep> is TRUE, the callback structure will not be freed.
3982 * If <toplevel> is TRUE, the callback is called directly from
3983 * the backend (as opposed to from a running program) which makes
3984 * certain extra setups for current_object and current_prog necessary.
3985 *
3986 * This function is #defined to two macros:
3987 *
3988 * apply_callback(cb,nargs): call a callback from a running program,
3989 * the callback is kept.
3990 * backend_callback(cb,nargs): call a callback from the backend
3991 * and free it afterwards.
3992 */
3993
3994 {
3995 object_t *ob;
3996 int num_arg;
3997
3998 ob = callback_object(cb);
3999 if (!ob
4000 || (O_PROG_SWAPPED(ob) && load_ob_from_swap(ob) < 0)
4001 )
4002 {
4003 while (nargs-- > 0)
4004 free_svalue(inter_sp--);
4005 free_callback(cb);
4006 return NULL;
4007 }
4008
4009 /* Push the arguments, if any, onto the stack */
4010
4011 num_arg = cb->num_arg;
4012
4013 if (num_arg)
4014 {
4015 svalue_t * argp;
4016 int j;
4017
4018 if (num_arg > 1)
4019 argp = cb->arg.u.lvalue;
4020 else
4021 argp = &(cb->arg);
4022
4023 for (j = 0; j < num_arg; j++, argp++)
4024 {
4025 inter_sp++;
4026 if (destructed_object_ref(argp))
4027 {
4028 *inter_sp = const0;
4029 assign_svalue(argp, &const0);
4030 }
4031 else if (keep)
4032 assign_svalue_no_free(inter_sp, argp);
4033 else
4034 transfer_svalue_no_free(inter_sp, argp);
4035 }
4036
4037 }
4038
4039 if (!keep)
4040 {
4041 /* The arguments are gone from the callback */
4042
4043 if (cb->num_arg > 1)
4044 xfree(cb->arg.u.lvalue);
4045 cb->num_arg = 0;
4046 cb->arg.type = T_INVALID;
4047 }
4048
4049 /* Now call the function */
4050
4051 if (toplevel)
4052 current_object = ob; /* Need something valid here */
4053
4054 if (cb->is_lambda)
4055 {
4056 if (toplevel
4057 && cb->function.lambda.x.closure_type < CLOSURE_SIMUL_EFUN
4058 && cb->function.lambda.x.closure_type >= CLOSURE_EFUN)
4059 {
4060 /* efun, operator or sefun closure called from the backend:
4061 * we need the program for a proper traceback. We made sure
4062 * before that the program has been swapped in.
4063 */
4064 current_prog = ob->prog;
4065 }
4066
4067 call_lambda(&(cb->function.lambda), num_arg + nargs);
4068 transfer_svalue(&apply_return_value, inter_sp);
4069 inter_sp--;
4070 }
4071 else
4072 {
4073 if (toplevel)
4074 tracedepth = 0;
4075
4076 if (!sapply(cb->function.named.name, ob, num_arg + nargs))
4077 transfer_svalue(&apply_return_value, &const0);
4078 }
4079
4080 if (!keep)
4081 {
4082 /* Free the remaining information from the callback structure */
4083 free_callback(cb);
4084 }
4085
4086 /* Return the result */
4087 return &apply_return_value;
4088 } /* execute_callback() */
4089
4090 /*-------------------------------------------------------------------------*/
4091 #ifdef DEBUG
4092
4093 void
count_callback_extra_refs(callback_t * cb)4094 count_callback_extra_refs (callback_t *cb)
4095
4096 /* Count all the refs in the callback to verify the normal refcounting. */
4097
4098 {
4099 if (!cb->is_lambda)
4100 count_extra_ref_in_object(cb->function.named.ob);
4101 else
4102 count_extra_ref_in_vector(&cb->function.lambda, 1);
4103 if (cb->num_arg == 1)
4104 count_extra_ref_in_vector(&(cb->arg), 1);
4105 else if (cb->num_arg > 1)
4106 count_extra_ref_in_vector(cb->arg.u.lvalue, (size_t)cb->num_arg);
4107 } /* count_callback_extra_refs() */
4108
4109 #endif /* DEBUG */
4110
4111 #ifdef GC_SUPPORT
4112
4113 /*-------------------------------------------------------------------------*/
4114 void
clear_ref_in_callback(callback_t * cb)4115 clear_ref_in_callback (callback_t *cb)
4116
4117 /* GC support: clear the refs in the memory held by the callback
4118 * structure (but not of the structure itself!)
4119 */
4120
4121 {
4122 if (cb->num_arg == 1)
4123 clear_ref_in_vector(&(cb->arg), 1);
4124 else if (cb->num_arg > 1)
4125 {
4126 clear_ref_in_vector(cb->arg.u.lvalue, (size_t)cb->num_arg);
4127 if (!cb->arg.x.extern_args)
4128 clear_memory_reference(cb->arg.u.lvalue);
4129 }
4130
4131 if (cb->is_lambda)
4132 clear_ref_in_vector(&(cb->function.lambda), 1);
4133 else
4134 {
4135 #ifdef DEBUG
4136 if (!callback_object(cb))
4137 fatal("GC run on callback with stale object.\n");
4138 #endif
4139 clear_object_ref(cb->function.named.ob);
4140 }
4141 } /* clear_ref_in_callback() */
4142
4143 /*-------------------------------------------------------------------------*/
4144 void
count_ref_in_callback(callback_t * cb)4145 count_ref_in_callback (callback_t *cb)
4146
4147 /* GC support: count the refs in the memory held by the callback
4148 * structure (but not of the structure itself!)
4149 */
4150
4151 {
4152 if (cb->num_arg == 1)
4153 count_ref_in_vector(&(cb->arg), 1);
4154 else if (cb->num_arg > 1)
4155 {
4156 count_ref_in_vector(cb->arg.u.lvalue, (size_t)cb->num_arg);
4157 if (!cb->arg.x.extern_args)
4158 note_malloced_block_ref(cb->arg.u.lvalue);
4159 }
4160
4161 #ifdef DEBUG
4162 if (!callback_object(cb))
4163 fatal("GC run on callback with stale object.\n");
4164 #endif
4165 if (cb->is_lambda)
4166 count_ref_in_vector(&(cb->function.lambda), 1);
4167 else
4168 {
4169 cb->function.named.ob->ref++;
4170 count_ref_from_string(cb->function.named.name);
4171 }
4172 } /* count_ref_in_callback() */
4173
4174 #endif
4175
4176 /*-------------------------------------------------------------------------*/
4177 void
init_driver_hooks()4178 init_driver_hooks()
4179
4180 /* Init the driver hooks.
4181 */
4182
4183 {
4184 int i;
4185
4186 for (i = NUM_DRIVER_HOOKS; --i >= 0; )
4187 {
4188 put_number(driver_hook + i, 0);
4189 }
4190 } /* init_driver_hooks() */
4191
4192 /*-------------------------------------------------------------------------*/
4193 Bool
match_string(const char * match,const char * str,mp_int len)4194 match_string (const char * match, const char * str, mp_int len)
4195
4196 /* Test if the string <str> of length <len> matches the pattern <match>.
4197 * Allowed wildcards are
4198 * *: matches any sequence
4199 * ?: matches any single character
4200 * \: escapes the following wildcard
4201 *
4202 * The function is used by the compiler for inheritance specs, and by
4203 * f_get_dir().
4204 * TODO: Another utils.c candidate.
4205 */
4206
4207 {
4208 /* Loop over match and str */
4209 for (;;)
4210 {
4211 /* Act on the current match character */
4212 switch(*match)
4213 {
4214 case '?':
4215 if (--len < 0)
4216 return MY_FALSE;
4217 str++;
4218 match++;
4219 continue;
4220
4221 case '*':
4222 {
4223 char *str2;
4224 mp_int matchlen;
4225
4226 for (;;)
4227 {
4228 switch (*++match)
4229 {
4230 case '\0':
4231 return len >= 0;
4232 case '?':
4233 --len;
4234 str++;
4235 case '*':
4236 continue;
4237 case '\\':
4238 match++;
4239 default:
4240 break;
4241 }
4242 break;
4243 }
4244
4245 if (len <= 0)
4246 return MY_FALSE;
4247
4248 str2 = strpbrk(match + 1, "?*\\");
4249 if (!str2)
4250 {
4251 if ( (matchlen = strlen(match)) > len)
4252 return MY_FALSE;
4253 return strncmp(match, str + len - matchlen, matchlen) == 0;
4254 }
4255 else
4256 {
4257 matchlen = str2 - match;
4258 }
4259 /* matchlen >= 1 */
4260 if ((len -= matchlen) >= 0) do
4261 {
4262 if ( !(str2 = xmemmem(str, len + matchlen, match, matchlen)) )
4263 return MY_FALSE;
4264 len -= str2 - str;
4265 if (match_string(match + matchlen, str2 + matchlen, len))
4266 return MY_TRUE;
4267 str = str2 + 1;
4268 } while (--len >= 0);
4269 return MY_FALSE;
4270 }
4271
4272 case '\0':
4273 return len == 0;
4274
4275 case '\\':
4276 match++;
4277 if (*match == '\0')
4278 return MY_FALSE;
4279 /* Fall through ! */
4280
4281 default:
4282 if (--len >= 0 && *match == *str)
4283 {
4284 match++;
4285 str++;
4286 continue;
4287 }
4288 return MY_FALSE;
4289 } /* switch(*match) */
4290 } /* for(;;) */
4291 } /* match_string() */
4292
4293 /*-------------------------------------------------------------------------*/
4294 void
print_svalue(svalue_t * arg)4295 print_svalue (svalue_t *arg)
4296
4297 /* Print the value <arg> to the interactive user (exception: strings
4298 * are also written to non-interactive command_givers via tell_npc()).
4299 * The function is called for the efun write() and from
4300 * interpret:do_trace_call().
4301 *
4302 * The function can only print scalar values - arrays, mappings and
4303 * closures are only hinted at.
4304 */
4305
4306 {
4307 if (arg == NULL)
4308 {
4309 add_message("<NULL>");
4310 }
4311 else if (arg->type == T_STRING)
4312 {
4313 interactive_t *ip;
4314
4315 /* Strings sent to monsters are now delivered */
4316 if (command_giver && (command_giver->flags & O_ENABLE_COMMANDS)
4317 && !(O_SET_INTERACTIVE(ip, command_giver)) )
4318 {
4319 tell_npc(command_giver, arg->u.str);
4320 }
4321 else
4322 {
4323 add_message(FMT_STRING, arg->u.str);
4324 }
4325 }
4326 else if (arg->type == T_OBJECT)
4327 add_message("OBJ(%s)", get_txt(arg->u.ob->name));
4328 else if (arg->type == T_NUMBER)
4329 add_message("%"PRIdPINT, arg->u.number);
4330 else if (arg->type == T_FLOAT)
4331 {
4332 char buff[120];
4333
4334 snprintf(buff, sizeof(buff), "%g", READ_DOUBLE( arg ) );
4335 add_message("%s", buff);
4336 }
4337 else if (arg->type == T_POINTER)
4338 add_message("<ARRAY>");
4339 else if (arg->type == T_MAPPING)
4340 add_message("<MAPPING>");
4341 else if (arg->type == T_CLOSURE)
4342 add_message("<CLOSURE>");
4343 else
4344 add_message("<OTHER:%"PRIdPHINT">", arg->type);
4345 } /* print_svalue() */
4346
4347 /*=========================================================================*/
4348
4349 /* EFUNS */
4350
4351 /*-------------------------------------------------------------------------*/
4352 svalue_t *
f_clone_object(svalue_t * sp)4353 f_clone_object (svalue_t * sp)
4354
4355 /* EFUN clone_object()
4356 *
4357 * object clone_object(string name)
4358 * object clone_object(object template)
4359 *
4360 * Clone a new object from definition <name>, or alternatively from
4361 * the object <template>. In both cases, the new object is given an
4362 * unique name and returned.
4363 */
4364
4365 {
4366 object_t *ob;
4367
4368 /* Get the argument and clone the object */
4369 if (sp->type == T_STRING)
4370 {
4371 ob = clone_object(sp->u.str);
4372 }
4373 else
4374 {
4375 ob = clone_object(sp->u.ob->load_name);
4376 }
4377
4378 free_svalue(sp);
4379
4380 if (ob)
4381 {
4382 put_ref_object(sp, ob, "F_CLONE_OBJECT");
4383 }
4384 else
4385 put_number(sp, 0);
4386
4387 return sp;
4388 } /* f_clone_object() */
4389
4390 /*-------------------------------------------------------------------------*/
4391 svalue_t *
f_destruct(svalue_t * sp)4392 f_destruct (svalue_t * sp)
4393
4394 /* EFUN destruct()
4395 *
4396 * void destruct(object ob)
4397 *
4398 * Completely destroy and remove object ob (if not already done so).
4399 * After the call to destruct(), no global variables will exist any
4400 * longer, only local ones, and arguments.
4401 *
4402 * If an object self-destructs, it will not immediately terminate
4403 * execution. If the efun this_object() will be called by the
4404 * destructed object, the result will be 0.
4405 *
4406 * The efun accepts destructed objects as argument (which appear
4407 * as the number 0) and the simply acts as a no-op in that case.
4408 *
4409 * Internally, the object is not destructed immediately, but
4410 * instead put into a list and finally destructed after the
4411 * current execution has ended.
4412 */
4413
4414 {
4415 if (T_NUMBER != sp->type || sp->u.number)
4416 {
4417 if (sp->type != T_OBJECT)
4418 efun_arg_error(1, T_OBJECT, sp->type, sp);
4419 destruct_object(sp);
4420 }
4421 free_svalue(sp);
4422 sp--;
4423
4424 return sp;
4425 } /* f_destruct() */
4426
4427 /*-------------------------------------------------------------------------*/
4428 svalue_t *
f_find_object(svalue_t * sp)4429 f_find_object (svalue_t *sp)
4430
4431 /* EFUN find_object()
4432 *
4433 * object find_object(string str)
4434 *
4435 * Find an object with the file_name str. If the object isn't loaded,
4436 * it will not be found.
4437 */
4438
4439 {
4440 object_t *ob;
4441
4442 ob = find_object(sp->u.str);
4443 free_svalue(sp);
4444 if (ob)
4445 put_ref_object(sp, ob, "find_object");
4446 else
4447 put_number(sp, 0);
4448
4449 return sp;
4450 } /* f_find_object() */
4451
4452 /*-------------------------------------------------------------------------*/
4453 svalue_t *
f_load_object(svalue_t * sp)4454 f_load_object (svalue_t *sp)
4455
4456 /* EFUN load_object()
4457 *
4458 * object load_object(string name)
4459 *
4460 * Load the object from the file <name> and return it. If the
4461 * object already exists, just return it.
4462 *
4463 * This efun can be used only to load blueprints - for clones, use
4464 * the efun clone_object().
4465 */
4466
4467 {
4468 object_t *ob;
4469
4470 ob = get_object(sp->u.str);
4471 free_svalue(sp);
4472 if (ob)
4473 put_ref_object(sp, ob, "F_LOAD_OBJECT");
4474 else
4475 put_number(sp, 0);
4476 return sp;
4477 } /* f_load_object() */
4478
4479 /*-------------------------------------------------------------------------*/
4480 static Bool
validate_shadowing(object_t * ob)4481 validate_shadowing (object_t *ob)
4482
4483 /* May current_object shadow object 'ob'? We perform a number of tests
4484 * including calling master:query_allow_shadow().
4485 * TODO: Move all shadow functions into a separate file.
4486 */
4487
4488 {
4489 int i, j;
4490 object_t *cob;
4491 program_t *shadow, *victim;
4492 svalue_t *ret;
4493
4494 cob = current_object;
4495 shadow = cob->prog;
4496
4497 if (cob->flags & O_DESTRUCTED)
4498 return MY_FALSE;
4499
4500 if (O_PROG_SWAPPED(ob))
4501 if (load_ob_from_swap(ob) < 0)
4502 errorf("Out of memory: unswap object '%s'\n", get_txt(ob->name));
4503
4504 victim = ob->prog;
4505
4506 if (victim->flags & P_NO_SHADOW)
4507 errorf("shadow '%s' on '%s': Can't shadow a 'no_shadow' program.\n"
4508 , get_txt(cob->name), get_txt(ob->name));
4509
4510 if (cob->flags & O_SHADOW)
4511 {
4512 shadow_t *shadow_sent = O_GET_SHADOW(cob);
4513
4514 if (shadow_sent->shadowing)
4515 errorf("shadow '%s' on '%s': Already shadowing.\n"
4516 , get_txt(cob->name), get_txt(ob->name));
4517 if (shadow_sent->shadowed_by)
4518 errorf("shadow '%s' on '%s': Can't shadow when shadowed.\n"
4519 , get_txt(cob->name), get_txt(ob->name));
4520 }
4521
4522 if (cob->super)
4523 errorf("shadow '%s' on '%s': The shadow resides inside another object ('%s').\n"
4524 , get_txt(cob->name), get_txt(ob->name)
4525 , get_txt(cob->super->name));
4526
4527 if (ob->flags & O_SHADOW && O_GET_SHADOW(ob)->shadowing)
4528 errorf("shadow '%s' on '%s': Can't shadow a shadow.\n"
4529 , get_txt(cob->name), get_txt(ob->name));
4530
4531 if (ob == cob)
4532 errorf("shadow '%s' on '%s': Can't shadow self.\n"
4533 , get_txt(cob->name), get_txt(ob->name));
4534
4535 /* Make sure that we don't shadow 'nomask' functions.
4536 */
4537 for (i = shadow->num_function_names; --i >= 0; )
4538 {
4539 funflag_t flags;
4540 string_t *name;
4541 program_t *progp;
4542
4543 j = shadow->function_names[i];
4544 flags = shadow->functions[j];
4545 progp = shadow;
4546 while (flags & NAME_INHERITED)
4547 {
4548 inherit_t *inheritp;
4549
4550 inheritp = &progp->inherit[flags & INHERIT_MASK];
4551 j -= inheritp->function_index_offset;
4552 progp = inheritp->prog;
4553 flags = progp->functions[j];
4554 }
4555
4556 memcpy(&name, FUNCTION_NAMEP(progp->program + (flags & FUNSTART_MASK))
4557 , sizeof name
4558 );
4559
4560 if ( (j = find_function(name, victim)) >= 0
4561 && victim->functions[j] & TYPE_MOD_NO_MASK )
4562 {
4563 errorf("shadow '%s' on '%s': Illegal to shadow 'nomask' function '%s'.\n"
4564 , get_txt(ob->name), get_txt(cob->name), get_txt(name));
4565 }
4566 }
4567
4568 push_ref_object(inter_sp, ob, "shadow");
4569 ret = apply_master(STR_QUERY_SHADOW, 1);
4570
4571 if (!((ob->flags|cob->flags) & O_DESTRUCTED)
4572 && ret && !(ret->type == T_NUMBER && ret->u.number == 0))
4573 {
4574 return MY_TRUE;
4575 }
4576
4577 return MY_FALSE;
4578 } /* validate_shadowing() */
4579
4580 /*-------------------------------------------------------------------------*/
4581 svalue_t *
f_shadow(svalue_t * sp)4582 f_shadow (svalue_t *sp)
4583
4584 /* EFUN shadow()
4585 *
4586 * object shadow(object ob, int flag)
4587 *
4588 * If flag is non-zero then the current object will shadow ob. If
4589 * flag is 0 then either 0 will be returned or the object that is
4590 * shadowing ob.
4591 *
4592 * The calling object must be permitted by the master object to
4593 * do the shadowing. In most installations, an object that
4594 * defines the function query_prevent_shadow() to return 1
4595 * can't be shadowed, and the shadow() function will return 0
4596 * instead of ob.
4597 *
4598 * shadow() also fails if the calling object tries to shadow
4599 * a function that was defined as ``nomask'', if the program was
4600 * compiled with the #pragma no_shadow, or if the calling
4601 * object is already shadowing, is being shadowed, or has an
4602 * environment. Also the target ob must not be shadowing
4603 * something else.
4604 *
4605 * If an object A shadows an object B then all call_other() to B
4606 * will be redirected to A. If object A has not defined the
4607 * function, then the call will be passed to B. There is only on
4608 * object that can call functions in B with call_other(), and
4609 * that is A. Not even object B can call_other() itself. All
4610 * normal (internal) function calls inside B will however remain
4611 * internal to B.
4612 */
4613
4614 {
4615 object_t *ob;
4616
4617 /* Get the arguments */
4618 sp--;
4619 ob = sp->u.ob;
4620 deref_object(ob, "shadow");
4621
4622 if (sp[1].u.number == 0)
4623 {
4624 /* Just look for a possible shadow */
4625 ob = (ob->flags & O_SHADOW) ? O_GET_SHADOW(ob)->shadowed_by : NULL;
4626 if (ob)
4627 sp->u.ob = ref_object(ob, "shadow");
4628 else
4629 put_number(sp, 0);
4630 return sp;
4631 }
4632
4633 sp->type = T_NUMBER; /* validate_shadowing might destruct ob */
4634 assign_eval_cost();
4635 inter_sp = sp;
4636 if (validate_shadowing(ob))
4637 {
4638 /* Shadowing allowed */
4639
4640 shadow_t *shadow_sent, *co_shadow_sent;
4641
4642 /* The shadow is entered first in the chain.
4643 */
4644 assert_shadow_sent(ob);
4645 if (O_IS_INTERACTIVE(ob))
4646 O_GET_INTERACTIVE(ob)->catch_tell_activ = MY_TRUE;
4647 shadow_sent = O_GET_SHADOW(ob);
4648
4649 while (shadow_sent->shadowed_by)
4650 {
4651 ob = shadow_sent->shadowed_by;
4652 shadow_sent = O_GET_SHADOW(ob);
4653 }
4654
4655 assert_shadow_sent(current_object);
4656 co_shadow_sent = O_GET_SHADOW(current_object);
4657
4658 co_shadow_sent->shadowing = ob;
4659 shadow_sent->shadowed_by = current_object;
4660 put_ref_object(sp, ob, "shadow");
4661 return sp;
4662 }
4663
4664 /* Shadowing not allowed */
4665 put_number(sp, 0);
4666 return sp;
4667 } /* f_shadow() */
4668
4669 /*-------------------------------------------------------------------------*/
4670 svalue_t *
f_query_shadowing(svalue_t * sp)4671 f_query_shadowing (svalue_t *sp)
4672
4673 /* EFUN query_shadowing()
4674 *
4675 * object query_shadowing (object obj)
4676 *
4677 * The function returns the object which <obj> is currently
4678 * shadowing, or 0 if <obj> is not a shadow.
4679 */
4680
4681 {
4682
4683 object_t *ob;
4684
4685 ob = sp->u.ob;
4686 deref_object(ob, "shadow");
4687 ob = (ob->flags & O_SHADOW) ? O_GET_SHADOW(ob)->shadowing : NULL;
4688 if (ob)
4689 sp->u.ob = ref_object(ob, "shadow");
4690 else
4691 put_number(sp, 0);
4692
4693 return sp;
4694 } /* f_query_shadowing() */
4695
4696 /*-------------------------------------------------------------------------*/
4697 svalue_t *
f_unshadow(svalue_t * sp)4698 f_unshadow (svalue_t *sp)
4699
4700 /* EFUN unshadow()
4701 *
4702 * void unshadow(void)
4703 *
4704 * The calling object stops shadowing any other object.
4705 * If the calling object is being shadowed, that is also stopped.
4706 */
4707
4708 {
4709 shadow_t *shadow_sent, *shadowing_sent;
4710 object_t *shadowing, *shadowed_by;
4711
4712 if (current_object->flags & O_SHADOW
4713 && NULL != (shadowing = (shadow_sent = O_GET_SHADOW(current_object))->shadowing) )
4714 {
4715 shadowing_sent = O_GET_SHADOW(shadowing);
4716
4717 /* Our victim is now shadowed by our shadow */
4718 shadowed_by = shadow_sent->shadowed_by;
4719 shadowing_sent->shadowed_by = shadowed_by;
4720
4721 if ( NULL != shadowed_by )
4722 {
4723 /* Inform our shadow about its new victim */
4724 O_GET_SHADOW(shadowed_by)->shadowing = shadow_sent->shadowing;
4725 }
4726 else
4727 {
4728 /* Our victim is no longer shadowed, so maybe it
4729 * doesn't need its shadow sentence anymore.
4730 */
4731 remove_shadow_actions(current_object, shadowing);
4732 check_shadow_sent(shadowing);
4733 }
4734
4735 shadow_sent->shadowed_by = NULL;
4736 shadow_sent->shadowing = NULL;
4737
4738 check_shadow_sent(current_object);
4739 }
4740
4741 return sp;
4742 } /* f_unshadow() */
4743
4744 /*-------------------------------------------------------------------------*/
4745 svalue_t *
f_set_driver_hook(svalue_t * sp)4746 f_set_driver_hook (svalue_t *sp)
4747
4748 /* EFUN set_driver_hook()
4749 *
4750 * void set_driver_hook(int what, closure arg)
4751 * void set_driver_hook(int what, string arg)
4752 * void set_driver_hook(int what, string * arg)
4753 *
4754 * This privileged efun sets the driver hook 'what' (values are
4755 * defined in /sys/driverhooks.h) to 'arg'.
4756 * The exact meanings and types of 'arg' depend of the hook set.
4757 * To remove a hook, set 'arg' to 0.
4758 *
4759 * Raises a privilege violation ("set_driver_hook", this_object, what).
4760 *
4761 * See hooks(C) for a detailed discussion.
4762 */
4763
4764 {
4765 p_int n;
4766 svalue_t old;
4767
4768 /* Get the arguments */
4769 n = sp[-1].u.number;
4770
4771 if (n < 0 || n >= NUM_DRIVER_HOOKS)
4772 {
4773 errorf("Bad hook number: %"PRIdPINT", expected 0..%ld\n"
4774 , n, (long)NUM_DRIVER_HOOKS-1);
4775 /* NOTREACHED */
4776 return sp;
4777 }
4778
4779 /* Legal call? */
4780 if (!privilege_violation(STR_SET_DRIVER_HOOK, sp-1, sp))
4781 {
4782 free_svalue(sp);
4783 return sp - 2;
4784 }
4785
4786 old = driver_hook[n]; /* Remember this for freeing */
4787
4788 /* Check the type of the hook and set it if ok
4789 */
4790 switch(sp->type)
4791 {
4792 case T_NUMBER:
4793 if (sp->u.number == 0)
4794 {
4795 put_number(driver_hook + n, 0);
4796 break;
4797 }
4798 else if (n == H_REGEXP_PACKAGE)
4799 {
4800 if (sp->u.number != RE_PCRE
4801 && sp->u.number != RE_TRADITIONAL
4802 )
4803 {
4804 errorf("Bad value for hook %"PRIdPINT": got 0x%"PRIxPINT
4805 ", expected RE_PCRE (0x%lx) or RE_TRADITIONAL (0x%lx).\n"
4806 , n, sp->u.number
4807 , (long)RE_PCRE, (long)RE_TRADITIONAL
4808 );
4809 break;
4810 }
4811 goto default_test;
4812 }
4813 else
4814 {
4815 errorf("Bad value for hook %"PRIdPINT": got number, expected %s or 0.\n"
4816 , n
4817 , efun_arg_typename(hook_type_map[n]));
4818 break;
4819 }
4820 break;
4821
4822 case T_STRING:
4823 {
4824 string_t *str;
4825
4826 if ( !((1 << T_STRING) & hook_type_map[n]) )
4827 errorf("Bad value for hook %"PRIdPINT": got string, expected %s.\n"
4828 , n
4829 , efun_arg_typename(hook_type_map[n]));
4830
4831 str = make_tabled_from(sp->u.str); /* for faster apply()s */
4832 put_string(driver_hook + n, str);
4833 free_svalue(sp);
4834 if (n == H_NOECHO)
4835 mudlib_telopts();
4836 break;
4837 }
4838
4839 case T_MAPPING:
4840 if (!sp->u.map->num_values
4841 || sp->u.map->ref != 1 /* add_to_mapping() could zero num_values */)
4842 {
4843 errorf("Bad value for hook %"PRIdPINT": mapping is empty "
4844 "or has other references.\n", n);
4845 return sp;
4846 }
4847 goto default_test;
4848
4849 case T_POINTER:
4850 {
4851 vector_t *v = sp->u.vec;
4852
4853 if (v->ref > 1)
4854 {
4855 /* We need a genuine copy of the array */
4856 deref_array(v);
4857 sp->u.vec = v = slice_array(v, 0, VEC_SIZE(v)-1);
4858 }
4859
4860 if (n == H_INCLUDE_DIRS)
4861 {
4862 inter_sp = sp;
4863 set_inc_list(v);
4864 }
4865 goto default_test;
4866 }
4867
4868 case T_CLOSURE:
4869 if (sp->x.closure_type == CLOSURE_UNBOUND_LAMBDA
4870 && sp->u.lambda->ref == 1)
4871 {
4872 driver_hook[n] = *sp;
4873 driver_hook[n].x.closure_type = CLOSURE_LAMBDA;
4874 driver_hook[n].u.lambda->ob = ref_object(master_ob, "hook closure");
4875 if (n == H_NOECHO)
4876 {
4877 mudlib_telopts();
4878 }
4879 break;
4880 }
4881 else if (!CLOSURE_IS_LFUN(sp->x.closure_type))
4882 {
4883 errorf("Bad value for hook %"PRIdPINT": unbound lambda or "
4884 "lfun closure expected.\n", n);
4885 }
4886 /* FALLTHROUGH */
4887
4888 default:
4889 default_test:
4890 if ( !((1 << sp->type) & hook_type_map[n]) )
4891 {
4892 errorf("Bad value for hook %"PRIdPINT": got %s, expected %s.\n"
4893 , n, typename(sp->type), efun_arg_typename(hook_type_map[n]));
4894 break; /* flow control hint */
4895 }
4896
4897 driver_hook[n] = *sp;
4898
4899 if (n == H_NOECHO)
4900 {
4901 mudlib_telopts();
4902 }
4903 break;
4904 }
4905
4906 if (old.type != T_NUMBER)
4907 free_svalue(&old);
4908
4909 return sp - 2;
4910 } /* f_set_driver_hook() */
4911
4912 /*-------------------------------------------------------------------------*/
4913 svalue_t *
f_write(svalue_t * sp)4914 f_write (svalue_t *sp)
4915
4916 /* EFUN write()
4917 *
4918 * void write (mixed msg)
4919 *
4920 * Write out something to the current user. What exactly will
4921 * be printed in the end depends of the type of msg.
4922 *
4923 * If it is a string or a number then just prints it out.
4924 *
4925 * If it is an object then the object will be printed in the
4926 * form: "OBJ("+file_name((object)mix)+")"
4927 *
4928 * If it is an array just "<ARRAY>" will be printed.
4929 * If it is a mapping just "<MAPPING>" will be printed.
4930 * If it is a closure just "<CLOSURE>" will be printed.
4931 *
4932 * If the write() function is invoked by a command of an living
4933 * but not interactive object and the given argument is a string
4934 * then the lfun catch_tell() of the living will be invoked with
4935 * the message as argument.
4936 */
4937
4938 {
4939 object_t *save_command_giver = command_giver;
4940
4941 if (!command_giver
4942 && current_object->flags & O_SHADOW
4943 && O_GET_SHADOW(current_object)->shadowing)
4944 {
4945 command_giver = current_object;
4946 }
4947
4948 if (command_giver)
4949 {
4950 /* Send the message to the first object in the shadow list */
4951 if (command_giver->flags & O_SHADOW)
4952 while( O_GET_SHADOW(command_giver)->shadowing )
4953 command_giver = O_GET_SHADOW(command_giver)->shadowing;
4954 }
4955
4956 print_svalue(sp);
4957 command_giver = check_object(save_command_giver);
4958
4959 free_svalue(sp); sp--;
4960
4961 return sp;
4962 } /* f_write() */
4963
4964 /*-------------------------------------------------------------------------*/
4965 static void
set_single_limit(struct limits_context_s * result,int limit,svalue_t * svp)4966 set_single_limit ( struct limits_context_s * result
4967 , int limit
4968 , svalue_t *svp
4969 )
4970
4971 /* Set the limit #<limit> in *<result> to the value in <svp>.
4972 *
4973 * If the function encounters illegal limit tags or values, it throws
4974 * an error.
4975 */
4976
4977 {
4978 static char * limitnames[] = { "LIMIT_EVAL", "LIMIT_ARRAY", "LIMIT_MAPPING"
4979 , "LIMIT_BYTE", "LIMIT_FILE", "LIMIT_COST" };
4980
4981 p_int val;
4982
4983 if (svp->type != T_NUMBER)
4984 errorf("Illegal %s value: got a %s, expected a number\n"
4985 , limitnames[limit], typename(svp[limit].type));
4986
4987 val = svp->u.number;
4988
4989 if (limit == LIMIT_COST)
4990 {
4991 if (val == LIMIT_DEFAULT)
4992 result->use_cost = DEF_USE_EVAL_COST;
4993 else if (val != LIMIT_KEEP)
4994 result->use_cost = val;
4995 }
4996 else
4997 {
4998 if (val >= 0)
4999 {
5000 switch(limit)
5001 {
5002 case LIMIT_EVAL: result->max_eval = val; break;
5003 case LIMIT_ARRAY: result->max_array = val; break;
5004 case LIMIT_MAPPING_KEYS: result->max_map_keys = val; break;
5005 case LIMIT_MAPPING_SIZE: result->max_mapping = val; break;
5006 case LIMIT_BYTE: result->max_byte = val; break;
5007 case LIMIT_FILE: result->max_file = val; break;
5008 case LIMIT_CALLOUTS: result->max_callouts = val; break;
5009 default: errorf("Unimplemented limit #%d\n", limit);
5010 }
5011 }
5012 else if (val == LIMIT_DEFAULT)
5013 {
5014 switch(limit)
5015 {
5016 case LIMIT_EVAL: result->max_eval = def_eval_cost;
5017 break;
5018 case LIMIT_ARRAY: result->max_array = def_array_size;
5019 break;
5020 case LIMIT_MAPPING_KEYS:
5021 result->max_map_keys = def_mapping_keys;
5022 break;
5023 case LIMIT_MAPPING_SIZE:
5024 result->max_mapping = def_mapping_size;
5025 break;
5026 case LIMIT_BYTE: result->max_byte = def_byte_xfer;
5027 break;
5028 case LIMIT_FILE: result->max_file = def_file_xfer;
5029 break;
5030 case LIMIT_CALLOUTS: result->max_callouts = def_callouts;
5031 break;
5032 default: errorf("Unimplemented limit #%d\n", limit);
5033 }
5034 }
5035 else if (val != LIMIT_KEEP)
5036 errorf("Illegal %s value: %"PRIdPINT"\n", limitnames[limit], val);
5037 }
5038 } /* set_single_limit() */
5039
5040 /*-------------------------------------------------------------------------*/
5041 static void
extract_limits(struct limits_context_s * result,svalue_t * svp,int num,Bool tagged)5042 extract_limits ( struct limits_context_s * result
5043 , svalue_t *svp
5044 , int num
5045 , Bool tagged
5046 )
5047
5048 /* Extract the user-given runtime limits from <svp>...
5049 * and store them into <result>. If <tagged> is FALSE, <svp> points to an array
5050 * with the <num> values stored at the proper indices, otherwise <svp> points
5051 * to a series of <num>/2 (tag, value) pairs.
5052 *
5053 * If the function encounters illegal limit tags or values, it throws
5054 * an error.
5055 */
5056
5057 {
5058 /* Set the defaults (unchanged) limits */
5059 result->max_eval = max_eval_cost;
5060 result->max_array = max_array_size;
5061 result->max_mapping = max_mapping_size;
5062 result->max_map_keys = max_mapping_keys;
5063 result->max_callouts = max_callouts;
5064 result->max_byte = max_byte_xfer;
5065 result->max_file = max_file_xfer;
5066 result->use_cost = 0;
5067
5068 if (!tagged)
5069 {
5070 int limit;
5071
5072 for (limit = 0; limit < LIMIT_MAX && limit < num; limit++)
5073 {
5074 set_single_limit(result, limit, svp+limit);
5075 }
5076 }
5077 else
5078 {
5079 int i;
5080
5081 for (i = 0; i < num - 1; i += 2)
5082 {
5083 p_int limit;
5084
5085 if (svp[i].type != T_NUMBER)
5086 errorf("Illegal limit value: got a %s, expected a number\n"
5087 , typename(svp[i].type));
5088 limit = svp[i].u.number;
5089 if (limit < 0 || limit >= LIMIT_MAX)
5090 errorf("Illegal limit tag: %"PRIdPINT"\n", limit);
5091
5092 set_single_limit(result, limit, svp+i+1);
5093 }
5094 }
5095 } /* extract_limits() */
5096
5097 /*-------------------------------------------------------------------------*/
5098 static vector_t *
create_limits_array(struct limits_context_s * rtlimits)5099 create_limits_array (struct limits_context_s * rtlimits)
5100
5101 /* Create an array with the values from <rtlimits> and return it.
5102 * Return NULL if out of memory.
5103 */
5104
5105 {
5106 vector_t *vec;
5107
5108 vec = allocate_uninit_array(LIMIT_MAX);
5109 if (vec)
5110 {
5111 put_number(vec->item+LIMIT_EVAL, rtlimits->max_eval);
5112 put_number(vec->item+LIMIT_ARRAY, rtlimits->max_array);
5113 put_number(vec->item+LIMIT_MAPPING_KEYS, rtlimits->max_map_keys);
5114 put_number(vec->item+LIMIT_MAPPING_SIZE, rtlimits->max_mapping);
5115 put_number(vec->item+LIMIT_BYTE, rtlimits->max_byte);
5116 put_number(vec->item+LIMIT_FILE, rtlimits->max_file);
5117 put_number(vec->item+LIMIT_CALLOUTS, rtlimits->max_callouts);
5118 put_number(vec->item+LIMIT_COST, rtlimits->use_cost);
5119 }
5120
5121 return vec;
5122 } /* create_limits_array() */
5123
5124 /*-------------------------------------------------------------------------*/
5125 svalue_t *
v_limited(svalue_t * sp,int num_arg)5126 v_limited (svalue_t * sp, int num_arg)
5127
5128 /* EFUN limited()
5129 *
5130 * mixed limited(closure fun)
5131 * mixed limited(closure fun, int tag, int value, ...)
5132 * mixed limited(closure fun, int * limits [, mixed args...] )
5133 *
5134 * Call the function <fun> and execute it with the given runtime limits.
5135 * After the function exits, the currently active limits are restored.
5136 * Result of the efun is the result of the closure call.
5137 *
5138 * The arguments can be given in two ways: as an array (like the one
5139 * returned from query_limits(), or as a list of tagged values.
5140 * If the efun is used without any limit specification, all limits
5141 * are supposed to be 'unlimited'.
5142 *
5143 * The limit settings recognize three special values:
5144 * LIMIT_UNLIMITED: the limit is deactivated
5145 * LIMIT_KEEP: the former setting is kept
5146 * LIMIT_DEFAULT: the 'global' default setting is used.
5147 *
5148 * The efun causes a privilege violation ("limited", current_object, closure).
5149 */
5150
5151 {
5152 svalue_t *argp;
5153 vector_t *vec;
5154 struct limits_context_s limits;
5155 int cl_args;
5156
5157 if (!num_arg)
5158 errorf("No arguments given.\n");
5159
5160 argp = sp - num_arg + 1;
5161 cl_args = 0;
5162
5163 /* Get the limits */
5164 if (num_arg == 1)
5165 {
5166 limits.max_eval = 0;
5167 limits.max_array = 0;
5168 limits.max_mapping = 0;
5169 limits.max_map_keys = 0;
5170 limits.max_callouts = 0;
5171 limits.max_byte = 0;
5172 limits.max_file = 0;
5173 limits.use_cost = 1; /* smallest we can do */
5174 }
5175 else if (argp[1].type == T_POINTER && VEC_SIZE(argp[1].u.vec) < INT_MAX)
5176 {
5177 extract_limits(&limits, argp[1].u.vec->item
5178 , (int)VEC_SIZE(argp[1].u.vec)
5179 , MY_FALSE);
5180 cl_args = num_arg - 2;
5181 }
5182 else if (num_arg % 2 == 1)
5183 {
5184 extract_limits(&limits, argp+1, num_arg-1, MY_TRUE);
5185 cl_args = 0;
5186 }
5187 else
5188 {
5189 errorf("limited(): Invalid limit specification.\n");
5190 /* NOTREACHED */
5191 return sp;
5192 }
5193
5194 /* Create an array with the parsed limits to pass
5195 * to privilege violation and store it in argp[1] so that
5196 * it can be cleared in case of an error.
5197 */
5198 if (num_arg > 1)
5199 free_svalue(argp+1);
5200 else
5201 {
5202 push_number(sp, 0);
5203 num_arg++;
5204 }
5205
5206 vec = create_limits_array(&limits);
5207 if (!vec)
5208 {
5209 inter_sp = sp;
5210 errorf("(set_limits) Out of memory: array[%d] for call.\n"
5211 , LIMIT_MAX);
5212 /* NOTREACHED */
5213 return sp;
5214 }
5215 put_array(argp+1, vec);
5216
5217 /* If this object is destructed, no extern calls may be done */
5218 if (current_object->flags & O_DESTRUCTED
5219 || !privilege_violation2(STR_LIMITED, argp, argp+1, sp)
5220 )
5221 {
5222 sp = pop_n_elems(num_arg, sp);
5223 sp++;
5224 put_number(sp, 0);
5225 }
5226 else
5227 {
5228 struct limits_context_s context;
5229
5230 /* Save the current runtime limits and set the new ones */
5231 save_limits_context(&context);
5232 context.rt.last = rt_context;
5233 rt_context = (rt_context_t *)&context.rt;
5234
5235 max_eval_cost = limits.max_eval ? limits.max_eval + eval_cost : 0;
5236 /* Make sure that we get the requested amount of ticks, but remember
5237 * that '0' means 'limitless'
5238 */
5239 max_array_size = limits.max_array;
5240 max_mapping_size = limits.max_mapping;
5241 max_mapping_keys = limits.max_map_keys;
5242 max_byte_xfer = limits.max_byte;
5243 max_file_xfer = limits.max_file;
5244 max_callouts = limits.max_callouts;
5245 use_eval_cost = limits.use_cost;
5246
5247 assign_eval_cost();
5248 inter_sp = sp;
5249 call_lambda(argp, cl_args);
5250 sp = inter_sp;
5251
5252 /* Overwrite the closure with the result */
5253 free_svalue(argp); /* The closure might have self-destructed */
5254 *argp = *sp;
5255 sp--;
5256
5257 /* Free the remaining arguments from the efun call */
5258 sp = pop_n_elems(num_arg - cl_args - 1, sp);
5259
5260 /* Restore the old limits */
5261 max_eval_cost = limits.max_eval;
5262 /* the +eval_cost above was good for proper execution,
5263 * but might mislead the eval_cost evaluation in the
5264 * restore().
5265 */
5266 rt_context = context.rt.last;
5267 restore_limits_context(&context);
5268 }
5269
5270 /* Stack is clean and sp points to the result */
5271 return sp;
5272 } /* v_limited() */
5273
5274 /*-------------------------------------------------------------------------*/
5275 svalue_t *
v_set_limits(svalue_t * sp,int num_arg)5276 v_set_limits (svalue_t * sp, int num_arg)
5277
5278 /* EFUN set_limits()
5279 *
5280 * void set_limits(int tag, int value, ...)
5281 * void set_limits(int * limits)
5282 *
5283 * Set the default runtime limits from the given arguments. The new limits
5284 * will be in effect for the next execution thread.
5285 *
5286 * The arguments can be given in two ways: as an array (like the one
5287 * returned from query_limits(), or as a list of tagged values.
5288 * The limit settings recognize three special values:
5289 * LIMIT_UNLIMITED: the limit is deactivated
5290 * LIMIT_DEFAULT: the global setting is used.
5291 * LIMIT_KEEP: the former setting is kept
5292 *
5293 * The efun causes a privilege violation ("set_limits", current_object, first
5294 * arg).
5295 */
5296
5297 {
5298 svalue_t *argp;
5299 struct limits_context_s limits;
5300 vector_t *vec;
5301
5302 if (!num_arg)
5303 errorf("No arguments given.\n");
5304
5305 argp = sp - num_arg + 1;
5306
5307 if (num_arg == 1 && argp->type == T_POINTER && VEC_SIZE(argp->u.vec) < INT_MAX)
5308 extract_limits(&limits, argp->u.vec->item, (int)VEC_SIZE(argp->u.vec)
5309 , MY_FALSE);
5310 else if (num_arg % 2 == 0)
5311 extract_limits(&limits, argp, num_arg, MY_TRUE);
5312 else
5313 {
5314 errorf("set_limits(): Invalid limit specification.\n");
5315 /* NOTREACHED */
5316 return sp;
5317 }
5318
5319 /* On the stack, create an array with the parsed limits to pass
5320 * to privilege violation.
5321 */
5322 sp = pop_n_elems(num_arg, sp); /* sp == argp now */
5323 vec = create_limits_array(&limits);
5324 if (!vec)
5325 {
5326 inter_sp = sp;
5327 errorf("(set_limits) Out of memory: array[%d] for call.\n"
5328 , LIMIT_MAX);
5329 /* NOTREACHED */
5330 return sp;
5331 }
5332 push_array(sp, vec);
5333 num_arg = 1;
5334
5335 if (privilege_violation(STR_SET_LIMITS, argp, sp))
5336 {
5337 /* Now store the parsed limits into the variables */
5338 def_eval_cost = limits.max_eval;
5339 def_array_size = limits.max_array;
5340 def_mapping_size = limits.max_mapping;
5341 def_mapping_keys = limits.max_map_keys;
5342 def_byte_xfer = limits.max_byte;
5343 def_file_xfer = limits.max_file;
5344 def_callouts = limits.max_callouts;
5345 }
5346
5347 sp = pop_n_elems(num_arg, sp);
5348 return sp;
5349 } /* v_set_limits() */
5350
5351 /*-------------------------------------------------------------------------*/
5352 svalue_t *
f_query_limits(svalue_t * sp)5353 f_query_limits (svalue_t * sp)
5354
5355 /* EFUN query_limits()
5356 *
5357 * int * query_limits(int defaults)
5358 *
5359 * Return an array with the current runtime limits, resp. if defaults
5360 * is true, the default runtime limits. The entries in the returned
5361 * array are:
5362 *
5363 * int[LIMIT_EVAL]: the max number of eval costs
5364 * int[LIMIT_ARRAY]: the max number of array entries
5365 * int[LIMIT_MAPPING_SIZE]: the max number of mapping values
5366 * int[LIMIT_MAPPING_KEYS]: the max number of mapping entries
5367 * (LIMIT_MAPPING is an alias for LIMIT_MAPPING_KEYS)
5368 * int[LIMIT_BYTE]: the max number of bytes for one read/write_bytes()
5369 * int[LIMIT_FILE]: the max number of bytes for one read/write_file()
5370 * int[LIMIT_COST]: how to account for the evaluation cost
5371 *
5372 * A limit of '0' means 'no limit', except for LIMIT_COST.
5373 */
5374
5375 {
5376 vector_t *vec;
5377 Bool def;
5378
5379 def = sp->u.number != 0;
5380
5381 vec = allocate_uninit_array(LIMIT_MAX);
5382 if (!vec)
5383 {
5384 errorf("(query_limits) Out of memory: array[%d] for result.\n"
5385 , LIMIT_MAX);
5386 /* NOTREACHED */
5387 return sp;
5388 }
5389
5390 put_number(vec->item+LIMIT_EVAL, def ? def_eval_cost : max_eval_cost);
5391 put_number(vec->item+LIMIT_ARRAY, def ? def_array_size : max_array_size);
5392 put_number(vec->item+LIMIT_MAPPING_KEYS
5393 , def ? def_mapping_keys : max_mapping_keys);
5394 put_number(vec->item+LIMIT_MAPPING_SIZE
5395 , def ? def_mapping_size : max_mapping_size);
5396 put_number(vec->item+LIMIT_BYTE, def ? def_byte_xfer : max_byte_xfer);
5397 put_number(vec->item+LIMIT_FILE, def ? def_file_xfer : max_file_xfer);
5398 put_number(vec->item+LIMIT_CALLOUTS, def ? def_callouts : max_callouts);
5399 put_number(vec->item+LIMIT_COST, def ? DEF_USE_EVAL_COST : use_eval_cost);
5400
5401 /* No free_svalue: sp is a number */
5402 put_array(sp, vec);
5403 return sp;
5404 } /* f_query_limits() */
5405
5406 /***************************************************************************/
5407
5408