PageRenderTime 45ms CodeModel.GetById 22ms RepoModel.GetById 1ms app.codeStats 0ms

/src/core/c-error.c

https://github.com/WoodyLin/r3
C | 835 lines | 358 code | 124 blank | 353 comment | 73 complexity | a4ec293259c8dc776b38153d3279b2be MD5 | raw file
Possible License(s): Apache-2.0
  1. /***********************************************************************
  2. **
  3. ** REBOL [R3] Language Interpreter and Run-time Environment
  4. **
  5. ** Copyright 2012 REBOL Technologies
  6. ** REBOL is a trademark of REBOL Technologies
  7. **
  8. ** Licensed under the Apache License, Version 2.0 (the "License");
  9. ** you may not use this file except in compliance with the License.
  10. ** You may obtain a copy of the License at
  11. **
  12. ** http://www.apache.org/licenses/LICENSE-2.0
  13. **
  14. ** Unless required by applicable law or agreed to in writing, software
  15. ** distributed under the License is distributed on an "AS IS" BASIS,
  16. ** WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  17. ** See the License for the specific language governing permissions and
  18. ** limitations under the License.
  19. **
  20. ************************************************************************
  21. **
  22. ** Module: c-error.c
  23. ** Summary: error handling
  24. ** Section: core
  25. ** Author: Carl Sassenrath
  26. ** Notes:
  27. **
  28. ***********************************************************************/
  29. /*
  30. The Trap() functions are used for errors within the C code.
  31. TrapN() provides simple trampoline to the var-arg Make_Error()
  32. that constructs a new error object.
  33. The Make_Error function uses the error category objects to
  34. convert from an error code (integer) to error words and strings.
  35. Other important state information such as location of error
  36. and function context are also saved at this point.
  37. Throw_Error is called to throw the error back to a prior catch.
  38. A catch is defined using a set of C-macros. During the throw
  39. the error object is stored in a global: This_Error (because we
  40. cannot be sure that the longjmp value is able to hold a pointer
  41. on 64bit CPUs.)
  42. On the catch side, the Catch_Error function takes the error
  43. object and stores it into the value provided (normally on the
  44. DStack).
  45. Catch_Error can be extended to provide a debugging breakpoint
  46. for examining the call trace and context frames on the stack.
  47. */
  48. /*
  49. Error Handling
  50. Errors occur in two places:
  51. 1. evaluation of natives and actions
  52. 2. evaluation of a block
  53. When an error occurs, an error object is built and thrown back to
  54. the nearest prior catch function. The catch is a longjmp that was
  55. set by a TRY or similar native. At that point the interpreter stack
  56. can be either examined (for debugging) or restored to the current
  57. catch state.
  58. The error is returned from the catch as a disarmed error object. At
  59. that point, the error can be passed around and accessed as a normal
  60. object (although its datatype is ERROR!). The DISARM function
  61. becomes unnecessary and will simply copy the fields to a normal
  62. OBJECT! type.
  63. Using the new CAUSE native with the error object will re-activate
  64. the error and throw the error back further to the prior catch.
  65. The error object will include a new TRACE field that provides a back
  66. trace of the interpreter stack. This is a block of block pointers
  67. and may be clipped at some reasonable size (perhaps 10).
  68. When C code hits an error condition, it calls Trap(id, arg1, arg2, ...).
  69. This function takes a variable number of arguments.
  70. BREAK and RETURN
  71. TRY/RECOVER/EXCEPT.
  72. try [block]
  73. try/recover [block] [block]
  74. TRACE f1, :path/f1, or [f1 f2 f3]
  75. foo: func [[trace] ...]
  76. */
  77. #include "sys-core.h"
  78. #include "sys-state.h"
  79. // Globals or Threaded???
  80. static REBOL_STATE Top_State; // Boot var: holds error state during boot
  81. /***********************************************************************
  82. **
  83. */ void Check_Stack(void)
  84. /*
  85. ***********************************************************************/
  86. {
  87. if ((DSP + 100) > (REBINT)SERIES_REST(DS_Series))
  88. Trap0(RE_STACK_OVERFLOW);
  89. }
  90. /***********************************************************************
  91. **
  92. */ void Catch_Error(REBVAL *value)
  93. /*
  94. ** Gets the current error and stores it as a value.
  95. ** Normally the value is on the stack and is returned.
  96. **
  97. ***********************************************************************/
  98. {
  99. if (IS_NONE(TASK_THIS_ERROR)) Crash(RP_ERROR_CATCH);
  100. *value = *TASK_THIS_ERROR;
  101. // Print("CE: %r", value);
  102. SET_NONE(TASK_THIS_ERROR);
  103. //!!! Reset or ENABLE_GC;
  104. }
  105. /***********************************************************************
  106. **
  107. */ void Throw_Error(REBSER *err)
  108. /*
  109. ** Throw the C stack.
  110. **
  111. ***********************************************************************/
  112. {
  113. if (!Saved_State) Crash(RP_NO_SAVED_STATE);
  114. SET_ERROR(TASK_THIS_ERROR, ERR_NUM(err), err);
  115. if (Trace_Level) Trace_Error(TASK_THIS_ERROR);
  116. longjmp(*Saved_State, 1);
  117. }
  118. /***********************************************************************
  119. **
  120. */ void Throw_Break(REBVAL *val)
  121. /*
  122. ** Throw a break or return style error (for special cases
  123. ** where we do not want to unwind the stack).
  124. **
  125. ***********************************************************************/
  126. {
  127. if (!Saved_State) Crash(RP_NO_SAVED_STATE);
  128. *TASK_THIS_ERROR = *val;
  129. longjmp(*Saved_State, 1);
  130. }
  131. /***********************************************************************
  132. **
  133. */ void Throw_Return_Series(REBCNT type, REBSER *series)
  134. /*
  135. ** Throws a series value using error temp values.
  136. **
  137. ***********************************************************************/
  138. {
  139. REBVAL *val;
  140. REBVAL *err;
  141. REBSER *blk = VAL_SERIES(TASK_ERR_TEMPS);
  142. RESET_SERIES(blk);
  143. val = Append_Value(blk);
  144. Set_Series(type, val, series);
  145. err = Append_Value(blk);
  146. SET_THROW(err, RE_RETURN, val);
  147. VAL_ERR_SYM(err) = SYM_RETURN; // indicates it is "virtual" (parse return)
  148. Throw_Break(err);
  149. }
  150. /***********************************************************************
  151. **
  152. */ void Throw_Return_Value(REBVAL *value)
  153. /*
  154. ** Throws a series value using error temp values.
  155. **
  156. ***********************************************************************/
  157. {
  158. REBVAL *val;
  159. REBVAL *err;
  160. REBSER *blk = VAL_SERIES(TASK_ERR_TEMPS);
  161. RESET_SERIES(blk);
  162. val = Append_Value(blk);
  163. *val = *value;
  164. err = Append_Value(blk);
  165. SET_THROW(err, RE_RETURN, val);
  166. VAL_ERR_SYM(err) = SYM_RETURN; // indicates it is "virtual" (parse return)
  167. Throw_Break(err);
  168. }
  169. /***********************************************************************
  170. **
  171. */ void Trap_Stack()
  172. /*
  173. ***********************************************************************/
  174. {
  175. if (IS_INTEGER(TASK_THIS_ERROR)) return; // composing prior error.
  176. if (!Saved_State) Crash(RP_NO_SAVED_STATE);
  177. *TASK_THIS_ERROR = *TASK_STACK_ERROR; // pre-allocated
  178. longjmp(*Saved_State, 1);
  179. }
  180. /***********************************************************************
  181. **
  182. */ REBCNT Stack_Depth()
  183. /*
  184. ***********************************************************************/
  185. {
  186. REBCNT dsf = DSF;
  187. REBCNT count = 0;
  188. for (dsf = DSF; dsf > 0; dsf = PRIOR_DSF(dsf)) {
  189. count++;
  190. }
  191. return count;
  192. }
  193. /***********************************************************************
  194. **
  195. */ REBSER *Make_Backtrace(REBINT start)
  196. /*
  197. ** Return a block of backtrace words.
  198. **
  199. ***********************************************************************/
  200. {
  201. REBCNT depth = Stack_Depth();
  202. REBSER *blk = Make_Block(depth-start);
  203. REBINT dsf;
  204. REBVAL *val;
  205. for (dsf = DSF; dsf > 0; dsf = PRIOR_DSF(dsf)) {
  206. if (start-- <= 0) {
  207. val = Append_Value(blk);
  208. Init_Word(val, VAL_WORD_SYM(DSF_WORD(dsf)));
  209. }
  210. }
  211. return blk;
  212. }
  213. /***********************************************************************
  214. **
  215. */ void Set_Error_Type(ERROR_OBJ *error)
  216. /*
  217. ** Sets error type and id fields based on code number.
  218. **
  219. ***********************************************************************/
  220. {
  221. REBSER *cats; // Error catalog object
  222. REBSER *cat; // Error category object
  223. REBCNT n; // Word symbol number
  224. REBCNT code;
  225. code = VAL_INT32(&error->code);
  226. // Set error category:
  227. n = code / 100 + 1;
  228. cats = VAL_OBJ_FRAME(Get_System(SYS_CATALOG, CAT_ERRORS));
  229. if (code >= 0 && n < SERIES_TAIL(cats) &&
  230. NZ(cat = VAL_SERIES(BLK_SKIP(cats, n)))
  231. ) {
  232. Set_Word(&error->type, FRM_WORD_SYM(cats, n), cats, n);
  233. // Find word related to the error itself:
  234. n = code % 100 + 3;
  235. if (n < SERIES_TAIL(cat))
  236. Set_Word(&error->id, FRM_WORD_SYM(cat, n), cat, n);
  237. }
  238. }
  239. /***********************************************************************
  240. **
  241. */ REBVAL *Find_Error_Info(ERROR_OBJ *error, REBINT *num)
  242. /*
  243. ** Return the error message needed to print an error.
  244. ** Must scan the error catalog and its error lists.
  245. ** Note that the error type and id words no longer need
  246. ** to be bound to the error catalog context.
  247. ** If the message is not found, return null.
  248. **
  249. ***********************************************************************/
  250. {
  251. REBSER *frame;
  252. REBVAL *obj1;
  253. REBVAL *obj2;
  254. if (!IS_WORD(&error->type) || !IS_WORD(&error->id)) return 0;
  255. // Find the correct error type object in the catalog:
  256. frame = VAL_OBJ_FRAME(Get_System(SYS_CATALOG, CAT_ERRORS));
  257. obj1 = Find_Word_Value(frame, VAL_WORD_SYM(&error->type));
  258. if (!obj1) return 0;
  259. // Now find the correct error message for that type:
  260. frame = VAL_OBJ_FRAME(obj1);
  261. obj2 = Find_Word_Value(frame, VAL_WORD_SYM(&error->id));
  262. if (!obj2) return 0;
  263. if (num) {
  264. obj1 = Find_Word_Value(frame, SYM_CODE);
  265. *num = VAL_INT32(obj1)
  266. + Find_Word_Index(frame, VAL_WORD_SYM(&error->id), FALSE)
  267. - Find_Word_Index(frame, SYM_TYPE, FALSE) - 1;
  268. }
  269. return obj2;
  270. }
  271. /***********************************************************************
  272. **
  273. */ void Make_Error_Object(REBVAL *arg, REBVAL *value)
  274. /*
  275. ** Creates an error object from arg and puts it in value.
  276. ** The arg can be a string or an object body block.
  277. ** This function is called by MAKE ERROR!.
  278. **
  279. ***********************************************************************/
  280. {
  281. REBSER *err; // Error object
  282. ERROR_OBJ *error; // Error object values
  283. REBINT code = 0;
  284. // Create a new error object from another object, including any non-standard fields:
  285. if (IS_ERROR(arg) || IS_OBJECT(arg)) {
  286. err = Merge_Frames(VAL_OBJ_FRAME(ROOT_ERROBJ),
  287. IS_ERROR(arg) ? VAL_OBJ_FRAME(arg) : VAL_ERR_OBJECT(arg));
  288. error = ERR_VALUES(err);
  289. // if (!IS_INTEGER(&error->code)) {
  290. if (!Find_Error_Info(error, &code)) code = RE_INVALID_ERROR;
  291. SET_INTEGER(&error->code, code);
  292. // }
  293. SET_ERROR(value, VAL_INT32(&error->code), err);
  294. return;
  295. }
  296. // Make a copy of the error object template:
  297. err = CLONE_OBJECT(VAL_OBJ_FRAME(ROOT_ERROBJ));
  298. error = ERR_VALUES(err);
  299. SET_NONE(&error->id);
  300. SET_ERROR(value, 0, err);
  301. // If block arg, evaluate object values (checking done later):
  302. // If user set error code, use it to setup type and id fields.
  303. if (IS_BLOCK(arg)) {
  304. DISABLE_GC;
  305. Do_Bind_Block(err, arg); // GC-OK (disabled)
  306. ENABLE_GC;
  307. if (IS_INTEGER(&error->code) && VAL_INT64(&error->code)) {
  308. Set_Error_Type(error);
  309. } else {
  310. if (Find_Error_Info(error, &code)) {
  311. SET_INTEGER(&error->code, code);
  312. }
  313. }
  314. // The error code is not valid:
  315. if (IS_NONE(&error->id)) {
  316. SET_INTEGER(&error->code, RE_INVALID_ERROR);
  317. Set_Error_Type(error);
  318. }
  319. if (VAL_INT64(&error->code) < 100 || VAL_INT64(&error->code) > 1000)
  320. Trap_Arg(arg);
  321. }
  322. // If string arg, setup other fields
  323. else if (IS_STRING(arg)) {
  324. SET_INTEGER(&error->code, RE_USER); // user error
  325. Set_String(&error->arg1, Copy_Series_Value(arg));
  326. Set_Error_Type(error);
  327. }
  328. // No longer allowed:
  329. // else if (IS_INTEGER(arg)) {
  330. // error->code = *arg;
  331. // Set_Error_Type(error);
  332. // }
  333. else
  334. Trap_Arg(arg);
  335. if (!(VAL_ERR_NUM(value) = VAL_INT32(&error->code))) {
  336. Trap_Arg(arg);
  337. }
  338. }
  339. /***********************************************************************
  340. **
  341. */ REBSER *Make_Error(REBINT code, REBVAL *arg1, REBVAL *arg2, REBVAL *arg3)
  342. /*
  343. ** Create and init a new error object.
  344. **
  345. ***********************************************************************/
  346. {
  347. REBSER *err; // Error object
  348. ERROR_OBJ *error; // Error object values
  349. if (PG_Boot_Phase < BOOT_ERRORS) Crash(RP_EARLY_ERROR, code); // Not far enough!
  350. // Make a copy of the error object template:
  351. err = CLONE_OBJECT(VAL_OBJ_FRAME(ROOT_ERROBJ));
  352. error = ERR_VALUES(err);
  353. // Set error number:
  354. SET_INTEGER(&error->code, (REBINT)code);
  355. Set_Error_Type(error);
  356. // Set error argument values:
  357. if (arg1) error->arg1 = *arg1;
  358. if (arg2) error->arg2 = *arg2;
  359. if (arg3) error->arg3 = *arg3;
  360. // Set backtrace and location information:
  361. if (DSF > 0) {
  362. // Where (what function) is the error:
  363. Set_Block(&error->where, Make_Backtrace(0));
  364. // Nearby location of the error (in block being evaluated):
  365. error->nearest = *DSF_BACK(DSF);
  366. }
  367. return err;
  368. }
  369. /***********************************************************************
  370. **
  371. */ void Trap0(REBCNT num)
  372. /*
  373. ***********************************************************************/
  374. {
  375. Throw_Error(Make_Error(num, 0, 0, 0));
  376. }
  377. /***********************************************************************
  378. **
  379. */ void Trap1(REBCNT num, REBVAL *arg1)
  380. /*
  381. ***********************************************************************/
  382. {
  383. Throw_Error(Make_Error(num, arg1, 0, 0));
  384. }
  385. /***********************************************************************
  386. **
  387. */ void Trap2(REBCNT num, REBVAL *arg1, REBVAL *arg2)
  388. /*
  389. ***********************************************************************/
  390. {
  391. Throw_Error(Make_Error(num, arg1, arg2, 0));
  392. }
  393. /***********************************************************************
  394. **
  395. */ void Trap3(REBCNT num, REBVAL *arg1, REBVAL *arg2, REBVAL *arg3)
  396. /*
  397. ***********************************************************************/
  398. {
  399. Throw_Error(Make_Error(num, arg1, arg2, arg3));
  400. }
  401. /***********************************************************************
  402. **
  403. */ void Trap_Arg(REBVAL *arg)
  404. /*
  405. ***********************************************************************/
  406. {
  407. Trap1(RE_INVALID_ARG, arg);
  408. }
  409. /***********************************************************************
  410. **
  411. */ void Trap_Type(REBVAL *arg)
  412. /*
  413. ** <type> type is not allowed here
  414. **
  415. ***********************************************************************/
  416. {
  417. Trap1(RE_INVALID_TYPE, Of_Type(arg));
  418. }
  419. /***********************************************************************
  420. **
  421. */ void Trap_Range(REBVAL *arg)
  422. /*
  423. ** value out of range: <value>
  424. **
  425. ***********************************************************************/
  426. {
  427. Trap1(RE_OUT_OF_RANGE, arg);
  428. }
  429. /***********************************************************************
  430. **
  431. */ void Trap_Word(REBCNT num, REBCNT sym, REBVAL *arg)
  432. /*
  433. ***********************************************************************/
  434. {
  435. Init_Word(DS_TOP, sym);
  436. if (arg) Trap2(num, DS_TOP, arg);
  437. else Trap1(num, DS_TOP);
  438. }
  439. /***********************************************************************
  440. **
  441. */ void Trap_Action(REBCNT type, REBCNT action)
  442. /*
  443. ***********************************************************************/
  444. {
  445. Trap2(RE_CANNOT_USE, Get_Action_Word(action), Get_Type(type));
  446. }
  447. /***********************************************************************
  448. **
  449. */ void Trap_Math_Args(REBCNT type, REBCNT action)
  450. /*
  451. ***********************************************************************/
  452. {
  453. Trap2(RE_NOT_RELATED, Get_Action_Word(action), Get_Type(type));
  454. }
  455. /***********************************************************************
  456. **
  457. */ void Trap_Types(REBCNT errnum, REBCNT type1, REBCNT type2)
  458. /*
  459. ***********************************************************************/
  460. {
  461. if (type2 != 0) Trap2(errnum, Get_Type(type1), Get_Type(type2));
  462. Trap1(errnum, Get_Type(type1));
  463. }
  464. /***********************************************************************
  465. **
  466. */ void Trap_Expect(REBVAL *object, REBCNT index, REBCNT type)
  467. /*
  468. ** Object field is not of expected type.
  469. ** PORT expected SCHEME of OBJECT type
  470. **
  471. ***********************************************************************/
  472. {
  473. Trap3(RE_EXPECT_TYPE, Of_Type(object), Obj_Word(object, index), Get_Type(type));
  474. }
  475. /***********************************************************************
  476. **
  477. */ void Trap_Make(REBCNT type, REBVAL *spec)
  478. /*
  479. ***********************************************************************/
  480. {
  481. Trap2(RE_BAD_MAKE_ARG, Get_Type(type), spec);
  482. }
  483. /***********************************************************************
  484. **
  485. */ void Trap_Num(REBCNT err, REBCNT num)
  486. /*
  487. ***********************************************************************/
  488. {
  489. DS_PUSH_INTEGER(num);
  490. Trap1(err, DS_TOP);
  491. }
  492. /***********************************************************************
  493. **
  494. */ void Trap_Reflect(REBCNT type, REBVAL *arg)
  495. /*
  496. ***********************************************************************/
  497. {
  498. Trap_Arg(arg);
  499. }
  500. /***********************************************************************
  501. **
  502. */ void Trap_Port(REBCNT errnum, REBSER *port, REBINT err_code)
  503. /*
  504. ***********************************************************************/
  505. {
  506. REBVAL *spec = OFV(port, STD_PORT_SPEC);
  507. REBVAL *val;
  508. if (!IS_OBJECT(spec)) Trap0(RE_INVALID_PORT);
  509. val = Get_Object(spec, STD_PORT_SPEC_HEAD_REF); // most informative
  510. if (IS_NONE(val)) val = Get_Object(spec, STD_PORT_SPEC_HEAD_TITLE);
  511. DS_PUSH_INTEGER(err_code);
  512. Trap2(errnum, val, DS_TOP);
  513. }
  514. /***********************************************************************
  515. **
  516. */ REBINT Check_Error(REBVAL *val)
  517. /*
  518. ** Process a loop exceptions. Pass in the TOS value, returns:
  519. **
  520. ** 2 - if break/return, change val to that set by break
  521. ** 1 - if break
  522. ** -1 - if continue, change val to unset
  523. ** 0 - if not break or continue
  524. ** else: error if not an ERROR value
  525. **
  526. ***********************************************************************/
  527. {
  528. // It's UNSET, not an error:
  529. if (!IS_ERROR(val))
  530. Trap0(RE_NO_RETURN); //!!! change to special msg
  531. // If it's a BREAK, check for /return value:
  532. if (IS_BREAK(val)) {
  533. if (VAL_ERR_VALUE(val)) {
  534. *val = *VAL_ERR_VALUE(val);
  535. return 2;
  536. } else {
  537. SET_UNSET(val);
  538. return 1;
  539. }
  540. }
  541. if (IS_CONTINUE(val)) {
  542. SET_UNSET(val);
  543. return -1;
  544. }
  545. return 0;
  546. // Else: Let all other errors return as values.
  547. }
  548. /***********************************************************************
  549. **
  550. */ void Init_Errors(REBVAL *errors)
  551. /*
  552. ***********************************************************************/
  553. {
  554. REBSER *errs;
  555. REBVAL *val;
  556. // Create error objects and error type objects:
  557. *ROOT_ERROBJ = *Get_System(SYS_STANDARD, STD_ERROR);
  558. errs = Construct_Object(0, VAL_BLK(errors), 0);
  559. Set_Object(Get_System(SYS_CATALOG, CAT_ERRORS), errs);
  560. Set_Root_Series(TASK_ERR_TEMPS, Make_Block(3));
  561. // Create objects for all error types:
  562. for (val = BLK_SKIP(errs, 1); NOT_END(val); val++) {
  563. errs = Construct_Object(0, VAL_BLK(val), 0);
  564. SET_OBJECT(val, errs);
  565. }
  566. // Catch top level errors, to provide decent output:
  567. PUSH_STATE(Top_State, Saved_State);
  568. if (SET_JUMP(Top_State)) {
  569. POP_STATE(Top_State, Saved_State);
  570. DSP++; // Room for return value
  571. Catch_Error(DS_TOP); // Stores error value here
  572. Print_Value(DS_TOP, 0, FALSE);
  573. Crash(RP_NO_CATCH);
  574. }
  575. SET_STATE(Top_State, Saved_State);
  576. }
  577. /***********************************************************************
  578. **
  579. */ REBYTE *Security_Policy(REBCNT sym, REBVAL *name)
  580. /*
  581. ** Given a security symbol (like FILE) and a value (like the file
  582. ** path) returns the security policy (RWX) allowed for it.
  583. **
  584. ** Args:
  585. **
  586. ** sym: word that represents the type ['file 'net]
  587. ** name: file or path value
  588. **
  589. ** Returns BTYE array of flags for the policy class:
  590. **
  591. ** flags: [rrrr wwww xxxx ----]
  592. **
  593. ** Where each byte is:
  594. ** 0: SEC_ALLOW
  595. ** 1: SEC_ASK
  596. ** 2: SEC_THROW
  597. ** 3: SEC_QUIT
  598. **
  599. ** The secuity is defined by the system/state/policies object, that
  600. ** is of the form:
  601. **
  602. ** [
  603. ** file: [%file1 tuple-flags %file2 ... default tuple-flags]
  604. ** net: [...]
  605. ** call: tuple-flags
  606. ** stack: tuple-flags
  607. ** eval: integer (limit)
  608. ** ]
  609. **
  610. ***********************************************************************/
  611. {
  612. REBVAL *policy = Get_System(SYS_STATE, STATE_POLICIES);
  613. REBYTE *flags;
  614. REBCNT len;
  615. REBCNT errcode = RE_SECURITY_ERROR;
  616. if (!IS_OBJECT(policy)) goto error;
  617. // Find the security class in the block: (file net call...)
  618. policy = Find_Word_Value(VAL_OBJ_FRAME(policy), sym);
  619. if (!policy) goto error;
  620. // Obtain the policies for it:
  621. // Check for a master tuple: [file rrrr.wwww.xxxx]
  622. if (IS_TUPLE(policy)) return VAL_TUPLE(policy); // non-aligned
  623. // removed A90: if (IS_INTEGER(policy)) return (REBYTE*)VAL_INT64(policy); // probably not used
  624. // Only other form is detailed block:
  625. if (!IS_BLOCK(policy)) goto error;
  626. // Scan block of policies for the class: [file [allow read quit write]]
  627. len = 0; // file or url length
  628. flags = 0; // policy flags
  629. for (policy = VAL_BLK(policy); NOT_END(policy); policy += 2) {
  630. // Must be a policy tuple:
  631. if (!IS_TUPLE(policy+1)) goto error;
  632. // Is it a policy word:
  633. if (IS_WORD(policy)) { // any word works here
  634. // If no strings found, use the default:
  635. if (len == 0) flags = VAL_TUPLE(policy+1); // non-aligned
  636. }
  637. // Is it a string (file or URL):
  638. else if (ANY_BINSTR(policy) && name) {
  639. //Debug_Fmt("sec: %r %r", policy, name);
  640. if (Match_Sub_Path(VAL_SERIES(policy), VAL_SERIES(name))) {
  641. // Is the match adequate?
  642. if (VAL_TAIL(name) >= len) {
  643. len = VAL_TAIL(name);
  644. flags = VAL_TUPLE(policy+1); // non-aligned
  645. }
  646. }
  647. }
  648. else goto error;
  649. }
  650. if (!flags) {
  651. errcode = RE_SECURITY;
  652. policy = name ? name : 0;
  653. error:
  654. if (!policy) {
  655. Init_Word(DS_TOP, sym);
  656. policy = DS_TOP;
  657. }
  658. Trap1(errcode, policy);
  659. }
  660. return flags;
  661. }
  662. /***********************************************************************
  663. **
  664. */ void Trap_Security(REBCNT flag, REBCNT sym, REBVAL *value)
  665. /*
  666. ** Take action on the policy flags provided. The sym and value
  667. ** are provided for error message purposes only.
  668. **
  669. ***********************************************************************/
  670. {
  671. if (flag == SEC_THROW) {
  672. if (!value) {
  673. Init_Word(DS_TOP, sym);
  674. value = DS_TOP;
  675. }
  676. Trap1(RE_SECURITY, value);
  677. }
  678. else if (flag == SEC_QUIT) OS_EXIT(101);
  679. }
  680. /***********************************************************************
  681. **
  682. */ void Check_Security(REBCNT sym, REBCNT policy, REBVAL *value)
  683. /*
  684. ** A helper function that fetches the security flags for
  685. ** a given symbol (FILE) and value (path), and then tests
  686. ** that they are allowed.
  687. **
  688. ***********************************************************************/
  689. {
  690. REBYTE *flags;
  691. flags = Security_Policy(sym, value);
  692. Trap_Security(flags[policy], sym, value);
  693. }