From 1060289f51ee1bf269bb45940892eb272d35af97 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Thu, 17 Dec 2020 11:20:55 +0100 Subject: Add a helper binary to create a basic Secure Computing filter. The binary uses the 'seccomp' helper library. The library isn't needed to load the generated Secure Computing filter. * configure.ac: Check for 'seccomp' header and library. * lib-src/seccomp-filter.c: New helper binary to generate a generic Secure Computing filter for GNU/Linux. * lib-src/Makefile.in (DONT_INSTALL): Add 'seccomp-filter' helper binary if possible. (all): Add Secure Computing filter file if possible. (seccomp-filter$(EXEEXT)): Compile helper binary. (seccomp-filter.bpf seccomp-filter.pfc): Generate filter files. * test/src/emacs-tests.el (emacs-tests/seccomp/allows-stdout) (emacs-tests/seccomp/forbids-subprocess): New unit tests. * test/Makefile.in (src/emacs-tests.log): Add dependency on the helper binary. --- .gitignore | 5 +++++ 1 file changed, 5 insertions(+) (limited to '.gitignore') diff --git a/.gitignore b/.gitignore index b653ef215b9..ecf768dc4d6 100644 --- a/.gitignore +++ b/.gitignore @@ -188,6 +188,7 @@ lib-src/make-docfile lib-src/make-fingerprint lib-src/movemail lib-src/profile +lib-src/seccomp-filter lib-src/test-distrib lib-src/update-game-score nextstep/Cocoa/Emacs.base/Contents/Info.plist @@ -301,3 +302,7 @@ nt/emacs.rc nt/emacsclient.rc src/gdb.ini /var/ + +# Seccomp filter files. +lib-src/seccomp-filter.bpf +lib-src/seccomp-filter.pfc -- cgit v1.2.3 From c8d542fd593f06b85d4b7b712378a4f84ec4d2b3 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sun, 11 Apr 2021 19:47:36 +0200 Subject: Add a variant of the Seccomp filter file that allows 'execve'. This is useful when starting Emacs with a Seccomp filter enabled, e.g. using 'bwrap'. * lib-src/seccomp-filter.c (main): Generate new Seccomp files. * lib-src/Makefile.in (all) (seccomp-filter.bpf seccomp-filter.pfc seccomp-filter-exec.bpf seccomp-filter-exec.pfc): Generate new Seccomp files. * .gitignore: Ignore new Seccomp files. * test/src/emacs-tests.el (emacs-tests/bwrap/allows-stdout): New unit test. --- .gitignore | 2 ++ lib-src/Makefile.in | 7 +++-- lib-src/seccomp-filter.c | 39 +++++++++++++++++++++--- test/src/emacs-resources/seccomp-filter-exec.bpf | 1 + test/src/emacs-tests.el | 33 ++++++++++++++++++++ 5 files changed, 75 insertions(+), 7 deletions(-) create mode 120000 test/src/emacs-resources/seccomp-filter-exec.bpf (limited to '.gitignore') diff --git a/.gitignore b/.gitignore index ecf768dc4d6..a1e3cb92f87 100644 --- a/.gitignore +++ b/.gitignore @@ -306,3 +306,5 @@ src/gdb.ini # Seccomp filter files. lib-src/seccomp-filter.bpf lib-src/seccomp-filter.pfc +lib-src/seccomp-filter-exec.bpf +lib-src/seccomp-filter-exec.pfc diff --git a/lib-src/Makefile.in b/lib-src/Makefile.in index 35cfa56d8be..091f4fb0199 100644 --- a/lib-src/Makefile.in +++ b/lib-src/Makefile.in @@ -240,7 +240,7 @@ config_h = ../src/config.h $(srcdir)/../src/conf_post.h all: ${EXE_FILES} ${SCRIPTS} ifeq ($(SECCOMP_FILTER),1) -all: seccomp-filter.bpf +all: seccomp-filter.bpf seccomp-filter-exec.bpf endif .PHONY: all need-blessmail maybe-blessmail @@ -430,9 +430,10 @@ seccomp-filter$(EXEEXT): $(srcdir)/seccomp-filter.c $(config_h) $(AM_V_CCLD)$(CC) $(ALL_CFLAGS) $(LIBSECCOMP_CFLAGS) $< \ $(LIBSECCOMP_LIBS) -o $@ -seccomp-filter.bpf seccomp-filter.pfc: seccomp-filter$(EXEEXT) +seccomp-filter.bpf seccomp-filter.pfc seccomp-filter-exec.bpf seccomp-filter-exec.pfc: seccomp-filter$(EXEEXT) $(AM_V_GEN)./seccomp-filter$(EXEEXT) \ - seccomp-filter.bpf seccomp-filter.pfc + seccomp-filter.bpf seccomp-filter.pfc \ + seccomp-filter-exec.bpf seccomp-filter-exec.pfc endif ## Makefile ends here. diff --git a/lib-src/seccomp-filter.c b/lib-src/seccomp-filter.c index a5f2e0adbca..ed362bc18d9 100644 --- a/lib-src/seccomp-filter.c +++ b/lib-src/seccomp-filter.c @@ -26,10 +26,12 @@ only a Linux kernel supporting the Secure Computing extension. Usage: - seccomp-filter out.bpf out.pfc + seccomp-filter out.bpf out.pfc out-exec.bpf out-exec.pfc This writes the raw `struct sock_filter' array to out.bpf and a -human-readable representation to out.pfc. */ +human-readable representation to out.pfc. Additionally, it writes +variants of those files that can be used to sandbox Emacs before +'execve' to out-exec.bpf and out-exec.pfc. */ #include "config.h" @@ -42,6 +44,7 @@ human-readable representation to out.pfc. */ #include #include +#include #include #include #include @@ -139,8 +142,9 @@ export_filter (const char *file, int main (int argc, char **argv) { - if (argc != 3) - fail (0, "usage: %s out.bpf out.pfc", argv[0]); + if (argc != 5) + fail (0, "usage: %s out.bpf out.pfc out-exec.bpf out-exec.pfc", + argv[0]); /* Any unhandled syscall should abort the Emacs process. */ ctx = seccomp_init (SCMP_ACT_KILL_PROCESS); @@ -156,6 +160,8 @@ main (int argc, char **argv) verify (CHAR_BIT == 8); verify (sizeof (int) == 4 && INT_MIN == INT32_MIN && INT_MAX == INT32_MAX); + verify (sizeof (long) == 8 && LONG_MIN == INT64_MIN + && LONG_MAX == INT64_MAX); verify (sizeof (void *) == 8); verify ((uintptr_t) NULL == 0); @@ -327,4 +333,29 @@ main (int argc, char **argv) EXPORT_FILTER (argv[1], seccomp_export_bpf); EXPORT_FILTER (argv[2], seccomp_export_pfc); + + /* When applying a Seccomp filter before executing the Emacs binary + (e.g. using the `bwrap' program), we need to allow further system + calls. Firstly, the wrapper binary will need to `execve' the + Emacs binary. Furthermore, the C library requires some system + calls at startup time to set up thread-local storage. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (execve)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (set_tid_address)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (arch_prctl), + SCMP_A0_32 (SCMP_CMP_EQ, ARCH_SET_FS)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (statfs)); + + /* We want to allow starting the Emacs binary itself with the + --seccomp flag, so we need to allow the `prctl' and `seccomp' + system calls. */ + RULE (SCMP_ACT_ALLOW, SCMP_SYS (prctl), + SCMP_A0_32 (SCMP_CMP_EQ, PR_SET_NO_NEW_PRIVS), + SCMP_A1_64 (SCMP_CMP_EQ, 1), SCMP_A2_64 (SCMP_CMP_EQ, 0), + SCMP_A3_64 (SCMP_CMP_EQ, 0), SCMP_A4_64 (SCMP_CMP_EQ, 0)); + RULE (SCMP_ACT_ALLOW, SCMP_SYS (seccomp), + SCMP_A0_32 (SCMP_CMP_EQ, SECCOMP_SET_MODE_FILTER), + SCMP_A1_32 (SCMP_CMP_EQ, SECCOMP_FILTER_FLAG_TSYNC)); + + EXPORT_FILTER (argv[3], seccomp_export_bpf); + EXPORT_FILTER (argv[4], seccomp_export_pfc); } diff --git a/test/src/emacs-resources/seccomp-filter-exec.bpf b/test/src/emacs-resources/seccomp-filter-exec.bpf new file mode 120000 index 00000000000..5b0e9978221 --- /dev/null +++ b/test/src/emacs-resources/seccomp-filter-exec.bpf @@ -0,0 +1 @@ +../../../lib-src/seccomp-filter-exec.bpf \ No newline at end of file diff --git a/test/src/emacs-tests.el b/test/src/emacs-tests.el index 89d811f8b4e..09f9a248efb 100644 --- a/test/src/emacs-tests.el +++ b/test/src/emacs-tests.el @@ -177,4 +177,37 @@ to `make-temp-file', which see." (ert-info ((format "Process output: %s" (buffer-string))) (should-not (eql status 0))))))) +(ert-deftest emacs-tests/bwrap/allows-stdout () + (let ((bash (executable-find "bash")) + (bwrap (executable-find "bwrap")) + (emacs + (expand-file-name invocation-name invocation-directory)) + (filter (ert-resource-file "seccomp-filter-exec.bpf")) + (process-environment nil)) + (skip-unless bash) + (skip-unless bwrap) + (skip-unless (file-executable-p emacs)) + (skip-unless (file-readable-p filter)) + (should-not (file-remote-p bwrap)) + (should-not (file-remote-p emacs)) + (should-not (file-remote-p filter)) + (with-temp-buffer + (let* ((command + (concat + (mapconcat #'shell-quote-argument + `(,(file-name-unquote bwrap) + "--ro-bind" "/" "/" + "--seccomp" "20" + "--" + ,(file-name-unquote emacs) + "--quick" "--batch" + ,(format "--eval=%S" '(message "Hi"))) + " ") + " 20< " + (shell-quote-argument (file-name-unquote filter)))) + (status (call-process bash nil t nil "-c" command))) + (ert-info ((format "Process output: %s" (buffer-string))) + (should (eql status 0))) + (should (equal (string-trim (buffer-string)) "Hi")))))) + ;;; emacs-tests.el ends here -- cgit v1.2.3 From 214dfbfea0cc7d64704aa4a258da542435c44cbb Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 12 Apr 2021 21:55:50 -0400 Subject: Don't version-control generated file `grammat-wy.el` This file is needed for CEDET's bootstrap, tho, so we now keep a copy of it under version control in `gram-wy-boot.el`, very much like we do with the `ldefs-boot.el` copy of `loaddefs.el`. * lisp/cedet/semantic/grm-wy-boot.el: Rename from `lisp/cedet/semantic/grammar-wy.el`. * lisp/cedet/semantic/grammar.el: Load `grm-wy-boot.el` if `grammar-wy.el` hasn't been generated yet. * admin/update_autogen: Also refresh `grm-wy-boot.el`. * admin/grammars/Makefile.in (WISENT): Add `grammar-wy.el` to the generated files. * .gitignore: Add `grammar-wy.el`. --- .gitignore | 1 + admin/grammars/Makefile.in | 13 +- admin/update_autogen | 12 +- lisp/cedet/semantic/grammar-wy.el | 503 ------------------------------------- lisp/cedet/semantic/grammar.el | 7 +- lisp/cedet/semantic/grm-wy-boot.el | 503 +++++++++++++++++++++++++++++++++++++ lisp/emacs-lisp/eieio-base.el | 3 +- 7 files changed, 525 insertions(+), 517 deletions(-) delete mode 100644 lisp/cedet/semantic/grammar-wy.el create mode 100644 lisp/cedet/semantic/grm-wy-boot.el (limited to '.gitignore') diff --git a/.gitignore b/.gitignore index a1e3cb92f87..c262f39126d 100644 --- a/.gitignore +++ b/.gitignore @@ -88,6 +88,7 @@ lisp/cedet/semantic/wisent/javat-wy.el lisp/cedet/semantic/wisent/js-wy.el lisp/cedet/semantic/wisent/python-wy.el lisp/cedet/srecode/srt-wy.el +lisp/cedet/semantic/grammar-wy.el lisp/eshell/esh-groups.el lisp/finder-inf.el lisp/leim/ja-dic/ diff --git a/admin/grammars/Makefile.in b/admin/grammars/Makefile.in index 35ce55461f3..4172411e034 100644 --- a/admin/grammars/Makefile.in +++ b/admin/grammars/Makefile.in @@ -51,14 +51,11 @@ BOVINE = \ ${bovinedir}/make-by.el \ ${bovinedir}/scm-by.el -## FIXME Should include this one too: -## ${cedetdir}/semantic/grammar-wy.el -## but semantic/grammar.el (which is what we use to generate grammar-wy.el) -## requires it! https://debbugs.gnu.org/16008 -WISENT = \ - ${wisentdir}/javat-wy.el \ - ${wisentdir}/js-wy.el \ - ${wisentdir}/python-wy.el \ +WISENT = \ + ${cedetdir}/semantic/grammar-wy.el \ + ${wisentdir}/javat-wy.el \ + ${wisentdir}/js-wy.el \ + ${wisentdir}/python-wy.el \ ${cedetdir}/srecode/srt-wy.el ALL = ${BOVINE} ${WISENT} diff --git a/admin/update_autogen b/admin/update_autogen index 35c391da19e..11c4313ae37 100755 --- a/admin/update_autogen +++ b/admin/update_autogen @@ -317,7 +317,7 @@ EOF echo "Finding loaddef targets..." find lisp -name '*.el' -exec grep '^;.*generated-autoload-file:' {} + | \ - sed -e '/loaddefs\|esh-groups/d' -e 's|/[^/]*: "|/|' -e 's/"//g' \ + sed -e '/loaddefs\|esh-groups/d' -e 's|/[^/]*: "|/|' -e 's/"//g' \ >| $tempfile || die "Error finding targets" genfiles= @@ -363,17 +363,23 @@ make -C lisp "$@" autoloads EMACS=../src/bootstrap-emacs || die "make src error" ## Ignore comment differences. -[ ! "$lboot_flag" ] || \ +[ ! "$lboot_flag" ] || \ diff -q -I '^;' $ldefs_in $ldefs_out || \ cp $ldefs_in $ldefs_out || die "cp ldefs_boot error" +# Refresh the prebuilt grammar-wy.el +grammar_in=lisp/cedet/semantic/grammar-wy.el +grammar_out=lisp/cedet/semantic/grm-wy-boot.el +make -C admin/grammars/ ../../$grammar_in +cp $grammar_in $grammar_out || die "cp grm_wy_boot error" + echo "Checking status of loaddef files..." ## It probably would be fine to just check+commit lisp/, since ## making autoloads should not effect any other files. But better ## safe than sorry. -modified=$(status $genfiles $ldefs_out) || die +modified=$(status $genfiles $ldefs_out $grammar_out) || die commit "loaddefs" $modified || die "commit error" diff --git a/lisp/cedet/semantic/grammar-wy.el b/lisp/cedet/semantic/grammar-wy.el deleted file mode 100644 index b3014034374..00000000000 --- a/lisp/cedet/semantic/grammar-wy.el +++ /dev/null @@ -1,503 +0,0 @@ -;;; semantic/grammar-wy.el --- Generated parser support file -*- lexical-binding:t -*- - -;; Copyright (C) 2002-2021 Free Software Foundation, Inc. - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: -;; -;; This file was generated from admin/grammars/grammar.wy. - -;;; Code: - -(require 'semantic/lex) -(require 'semantic/wisent) - -;;; Prologue -;; -(defvar semantic-grammar-lex-c-char-re) - -;; Current parsed nonterminal name. -(defvar semantic-grammar-wy--nterm nil) -;; Index of rule in a nonterminal clause. -(defvar semantic-grammar-wy--rindx nil) - -;;; Declarations -;; -(eval-and-compile (defconst semantic-grammar-wy--expected-conflicts - nil - "The number of expected shift/reduce conflicts in this grammar.")) - -(defconst semantic-grammar-wy--keyword-table - (semantic-lex-make-keyword-table - '(("%default-prec" . DEFAULT-PREC) - ("%no-default-prec" . NO-DEFAULT-PREC) - ("%keyword" . KEYWORD) - ("%languagemode" . LANGUAGEMODE) - ("%left" . LEFT) - ("%nonassoc" . NONASSOC) - ("%package" . PACKAGE) - ("%expectedconflicts" . EXPECTEDCONFLICTS) - ("%provide" . PROVIDE) - ("%prec" . PREC) - ("%put" . PUT) - ("%quotemode" . QUOTEMODE) - ("%right" . RIGHT) - ("%scopestart" . SCOPESTART) - ("%start" . START) - ("%token" . TOKEN) - ("%type" . TYPE) - ("%use-macros" . USE-MACROS)) - 'nil) - "Table of language keywords.") - -(defconst semantic-grammar-wy--token-table - (semantic-lex-make-type-table - '(("punctuation" - (GT . ">") - (LT . "<") - (OR . "|") - (SEMI . ";") - (COLON . ":")) - ("close-paren" - (RBRACE . "}") - (RPAREN . ")")) - ("open-paren" - (LBRACE . "{") - (LPAREN . "(")) - ("block" - (BRACE_BLOCK . "(LBRACE RBRACE)") - (PAREN_BLOCK . "(LPAREN RPAREN)")) - ("code" - (EPILOGUE . "%%...EOF") - (PROLOGUE . "%{...%}")) - ("sexp" - (SEXP)) - ("qlist" - (PREFIXED_LIST)) - ("char" - (CHARACTER)) - ("symbol" - (PERCENT_PERCENT . "\\`%%\\'") - (SYMBOL)) - ("string" - (STRING))) - '(("punctuation" :declared t) - ("block" :declared t) - ("sexp" matchdatatype sexp) - ("sexp" syntax "\\=") - ("sexp" :declared t) - ("qlist" matchdatatype sexp) - ("qlist" syntax "\\s'\\s-*(") - ("qlist" :declared t) - ("char" syntax semantic-grammar-lex-c-char-re) - ("char" :declared t) - ("symbol" syntax ":?\\(\\sw\\|\\s_\\)+") - ("symbol" :declared t) - ("string" :declared t) - ("keyword" :declared t))) - "Table of lexical tokens.") - -(defconst semantic-grammar-wy--parse-table - (wisent-compiled-grammar - ((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE LEFT NONASSOC PACKAGE EXPECTEDCONFLICTS PROVIDE PREC PUT QUOTEMODE RIGHT SCOPESTART START TOKEN TYPE USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST SEXP PROLOGUE EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE COLON SEMI OR LT GT) - nil - (grammar - ((prologue)) - ((epilogue)) - ((declaration)) - ((nonterminal)) - ((PERCENT_PERCENT))) - (prologue - ((PROLOGUE) - (wisent-raw-tag - (semantic-tag-new-code "prologue" nil)))) - (epilogue - ((EPILOGUE) - (wisent-raw-tag - (semantic-tag-new-code "epilogue" nil)))) - (declaration - ((decl) - (eval $1 t))) - (decl - ((default_prec_decl)) - ((no_default_prec_decl)) - ((languagemode_decl)) - ((package_decl)) - ((expectedconflicts_decl)) - ((provide_decl)) - ((precedence_decl)) - ((put_decl)) - ((quotemode_decl)) - ((scopestart_decl)) - ((start_decl)) - ((keyword_decl)) - ((token_decl)) - ((type_decl)) - ((use_macros_decl))) - (default_prec_decl - ((DEFAULT-PREC) - `(wisent-raw-tag - (semantic-tag "default-prec" 'assoc :value - '("t"))))) - (no_default_prec_decl - ((NO-DEFAULT-PREC) - `(wisent-raw-tag - (semantic-tag "default-prec" 'assoc :value - '("nil"))))) - (languagemode_decl - ((LANGUAGEMODE symbols) - `(wisent-raw-tag - (semantic-tag ',(car $2) - 'languagemode :rest ',(cdr $2))))) - (package_decl - ((PACKAGE SYMBOL) - `(wisent-raw-tag - (semantic-tag-new-package ',$2 nil)))) - (expectedconflicts_decl - ((EXPECTEDCONFLICTS symbols) - `(wisent-raw-tag - (semantic-tag ',(car $2) - 'expectedconflicts :rest ',(cdr $2))))) - (provide_decl - ((PROVIDE SYMBOL) - `(wisent-raw-tag - (semantic-tag ',$2 'provide)))) - (precedence_decl - ((associativity token_type_opt items) - `(wisent-raw-tag - (semantic-tag ',$1 'assoc :type ',$2 :value ',$3)))) - (associativity - ((LEFT) - (progn "left")) - ((RIGHT) - (progn "right")) - ((NONASSOC) - (progn "nonassoc"))) - (put_decl - ((PUT put_name put_value) - `(wisent-raw-tag - (semantic-tag ',$2 'put :value ',(list $3)))) - ((PUT put_name put_value_list) - `(wisent-raw-tag - (semantic-tag ',$2 'put :value ',$3))) - ((PUT put_name_list put_value) - `(wisent-raw-tag - (semantic-tag ',(car $2) - 'put :rest ',(cdr $2) - :value ',(list $3)))) - ((PUT put_name_list put_value_list) - `(wisent-raw-tag - (semantic-tag ',(car $2) - 'put :rest ',(cdr $2) - :value ',$3)))) - (put_name_list - ((BRACE_BLOCK) - (mapcar #'semantic-tag-name - (semantic-parse-region - (car $region1) - (cdr $region1) - 'put_names 1)))) - (put_names - ((LBRACE) - nil) - ((RBRACE) - nil) - ((put_name) - (wisent-raw-tag - (semantic-tag $1 'put-name)))) - (put_name - ((SYMBOL)) - ((token_type))) - (put_value_list - ((BRACE_BLOCK) - (mapcar #'semantic-tag-code-detail - (semantic-parse-region - (car $region1) - (cdr $region1) - 'put_values 1)))) - (put_values - ((LBRACE) - nil) - ((RBRACE) - nil) - ((put_value) - (wisent-raw-tag - (semantic-tag-new-code "put-value" $1)))) - (put_value - ((SYMBOL any_value) - (cons $1 $2))) - (scopestart_decl - ((SCOPESTART SYMBOL) - `(wisent-raw-tag - (semantic-tag ',$2 'scopestart)))) - (quotemode_decl - ((QUOTEMODE SYMBOL) - `(wisent-raw-tag - (semantic-tag ',$2 'quotemode)))) - (start_decl - ((START symbols) - `(wisent-raw-tag - (semantic-tag ',(car $2) - 'start :rest ',(cdr $2))))) - (keyword_decl - ((KEYWORD SYMBOL string_value) - `(wisent-raw-tag - (semantic-tag ',$2 'keyword :value ',$3)))) - (token_decl - ((TOKEN token_type_opt SYMBOL string_value) - `(wisent-raw-tag - (semantic-tag ',$3 ',(if $2 'token 'keyword) - :type ',$2 :value ',$4))) - ((TOKEN token_type_opt symbols) - `(wisent-raw-tag - (semantic-tag ',(car $3) - 'token :type ',$2 :rest ',(cdr $3))))) - (token_type_opt - (nil) - ((token_type))) - (token_type - ((LT SYMBOL GT) - (progn $2))) - (type_decl - ((TYPE token_type plist_opt) - `(wisent-raw-tag - (semantic-tag ',$2 'type :value ',$3)))) - (plist_opt - (nil) - ((plist))) - (plist - ((plist put_value) - (append - (list $2) - $1)) - ((put_value) - (list $1))) - (use_name_list - ((BRACE_BLOCK) - (mapcar #'semantic-tag-name - (semantic-parse-region - (car $region1) - (cdr $region1) - 'use_names 1)))) - (use_names - ((LBRACE) - nil) - ((RBRACE) - nil) - ((SYMBOL) - (wisent-raw-tag - (semantic-tag $1 'use-name)))) - (use_macros_decl - ((USE-MACROS SYMBOL use_name_list) - `(wisent-raw-tag - (semantic-tag "macro" 'macro :type ',$2 :value ',$3)))) - (string_value - ((STRING) - (read $1))) - (any_value - ((SYMBOL)) - ((STRING)) - ((PAREN_BLOCK)) - ((PREFIXED_LIST)) - ((SEXP))) - (symbols - ((lifo_symbols) - (nreverse $1))) - (lifo_symbols - ((lifo_symbols SYMBOL) - (cons $2 $1)) - ((SYMBOL) - (list $1))) - (nonterminal - ((SYMBOL - (setq semantic-grammar-wy--nterm $1 semantic-grammar-wy--rindx 0) - COLON rules SEMI) - (wisent-raw-tag - (semantic-tag $1 'nonterminal :children $4)))) - (rules - ((lifo_rules) - (apply #'nconc - (nreverse $1)))) - (lifo_rules - ((lifo_rules OR rule) - (cons $3 $1)) - ((rule) - (list $1))) - (rule - ((rhs) - (let* - ((nterm semantic-grammar-wy--nterm) - (rindx semantic-grammar-wy--rindx) - (rhs $1) - comps prec action elt) - (setq semantic-grammar-wy--rindx - (1+ semantic-grammar-wy--rindx)) - (while rhs - (setq elt - (car rhs) - rhs - (cdr rhs)) - (cond - ((vectorp elt) - (if prec - (error "Duplicate %%prec in `%s:%d' rule" nterm rindx)) - (setq prec - (aref elt 0))) - ((consp elt) - (if - (or action comps) - (setq comps - (cons elt comps) - semantic-grammar-wy--rindx - (1+ semantic-grammar-wy--rindx)) - (setq action - (car elt)))) - (t - (setq comps - (cons elt comps))))) - (wisent-cook-tag - (wisent-raw-tag - (semantic-tag - (format "%s:%d" nterm rindx) - 'rule :type - (if comps "group" "empty") - :value comps :prec prec :expr action)))))) - (rhs - (nil) - ((rhs item) - (cons $2 $1)) - ((rhs action) - (cons - (list $2) - $1)) - ((rhs PREC item) - (cons - (vector $3) - $1))) - (action - ((PAREN_BLOCK)) - ((PREFIXED_LIST)) - ((BRACE_BLOCK) - (format "(progn\n%s)" - (let - ((s $1)) - (if - (string-match "^{[ \n ]*" s) - (setq s - (substring s - (match-end 0)))) - (if - (string-match "[ \n ]*}$" s) - (setq s - (substring s 0 - (match-beginning 0)))) - s)))) - (items - ((lifo_items) - (nreverse $1))) - (lifo_items - ((lifo_items item) - (cons $2 $1)) - ((item) - (list $1))) - (item - ((SYMBOL)) - ((CHARACTER)))) - (grammar prologue epilogue declaration nonterminal rule put_names put_values use_names)) - "Parser table.") - -(defun semantic-grammar-wy--install-parser () - "Setup the Semantic Parser." - (semantic-install-function-overrides - '((semantic-parse-stream . wisent-parse-stream))) - (setq semantic-parser-name "LALR" - semantic--parse-table semantic-grammar-wy--parse-table - semantic-debug-parser-source "grammar.wy" - semantic-flex-keywords-obarray semantic-grammar-wy--keyword-table - semantic-lex-types-obarray semantic-grammar-wy--token-table) - ;; Collect unmatched syntax lexical tokens - (add-hook 'wisent-discarding-token-functions - #'wisent-collect-unmatched-syntax nil t)) - - -;;; Analyzers -;; -(define-lex-regex-type-analyzer semantic-grammar-wy---regexp-analyzer - "regexp analyzer for tokens." - ":?\\(\\sw\\|\\s_\\)+" - '((PERCENT_PERCENT . "\\`%%\\'")) - 'SYMBOL) - -(define-lex-keyword-type-analyzer semantic-grammar-wy---keyword-analyzer - "keyword analyzer for tokens." - "\\(\\sw\\|\\s_\\)+") - -(define-lex-regex-type-analyzer semantic-grammar-wy---regexp-analyzer - "regexp analyzer for tokens." - semantic-grammar-lex-c-char-re - nil - 'CHARACTER) - -(define-lex-sexp-type-analyzer semantic-grammar-wy---sexp-analyzer - "sexp analyzer for tokens." - "\\s'\\s-*(" - 'PREFIXED_LIST) - -(define-lex-block-type-analyzer semantic-grammar-wy---block-analyzer - "block analyzer for tokens." - "\\s(\\|\\s)" - '((("(" LPAREN PAREN_BLOCK) - ("{" LBRACE BRACE_BLOCK)) - (")" RPAREN) - ("}" RBRACE)) - ) - -(define-lex-string-type-analyzer semantic-grammar-wy---string-analyzer - "string analyzer for tokens." - "\\(\\s.\\|\\s$\\|\\s'\\)+" - '((GT . ">") - (LT . "<") - (OR . "|") - (SEMI . ";") - (COLON . ":")) - 'punctuation) - -(define-lex-sexp-type-analyzer semantic-grammar-wy---sexp-analyzer - "sexp analyzer for tokens." - "\\s\"" - 'STRING) - -(define-lex-sexp-type-analyzer semantic-grammar-wy---sexp-analyzer - "sexp analyzer for tokens." - "\\=" - 'SEXP) - - -;;; Epilogue -;; - - - - -(provide 'semantic/grammar-wy) - -;; Local Variables: -;; version-control: never -;; no-update-autoloads: t -;; End: - -;;; semantic/grammar-wy.el ends here diff --git a/lisp/cedet/semantic/grammar.el b/lisp/cedet/semantic/grammar.el index dba289fdd75..4c3bb6c238b 100644 --- a/lisp/cedet/semantic/grammar.el +++ b/lisp/cedet/semantic/grammar.el @@ -31,7 +31,12 @@ (require 'semantic/format) ;; FIXME this is a generated file, but we need to load this file to ;; generate it! -(require 'semantic/grammar-wy) +;; We need `semantic/grammar-wy.el' but we're also needed to generate +;; that file from `grammar.wy', so to break the dependency, we keep +;; a bootstrap copy of `grammar-wy.el' in `grm-wy-boot.el'. See bug#16008. +(eval-and-compile + (unless (require 'semantic/grammar-wy nil t) + (load "semantic/grm-wy-boot"))) (require 'semantic/idle) (require 'help-fns) (require 'semantic/analyze) diff --git a/lisp/cedet/semantic/grm-wy-boot.el b/lisp/cedet/semantic/grm-wy-boot.el new file mode 100644 index 00000000000..b3014034374 --- /dev/null +++ b/lisp/cedet/semantic/grm-wy-boot.el @@ -0,0 +1,503 @@ +;;; semantic/grammar-wy.el --- Generated parser support file -*- lexical-binding:t -*- + +;; Copyright (C) 2002-2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; +;; This file was generated from admin/grammars/grammar.wy. + +;;; Code: + +(require 'semantic/lex) +(require 'semantic/wisent) + +;;; Prologue +;; +(defvar semantic-grammar-lex-c-char-re) + +;; Current parsed nonterminal name. +(defvar semantic-grammar-wy--nterm nil) +;; Index of rule in a nonterminal clause. +(defvar semantic-grammar-wy--rindx nil) + +;;; Declarations +;; +(eval-and-compile (defconst semantic-grammar-wy--expected-conflicts + nil + "The number of expected shift/reduce conflicts in this grammar.")) + +(defconst semantic-grammar-wy--keyword-table + (semantic-lex-make-keyword-table + '(("%default-prec" . DEFAULT-PREC) + ("%no-default-prec" . NO-DEFAULT-PREC) + ("%keyword" . KEYWORD) + ("%languagemode" . LANGUAGEMODE) + ("%left" . LEFT) + ("%nonassoc" . NONASSOC) + ("%package" . PACKAGE) + ("%expectedconflicts" . EXPECTEDCONFLICTS) + ("%provide" . PROVIDE) + ("%prec" . PREC) + ("%put" . PUT) + ("%quotemode" . QUOTEMODE) + ("%right" . RIGHT) + ("%scopestart" . SCOPESTART) + ("%start" . START) + ("%token" . TOKEN) + ("%type" . TYPE) + ("%use-macros" . USE-MACROS)) + 'nil) + "Table of language keywords.") + +(defconst semantic-grammar-wy--token-table + (semantic-lex-make-type-table + '(("punctuation" + (GT . ">") + (LT . "<") + (OR . "|") + (SEMI . ";") + (COLON . ":")) + ("close-paren" + (RBRACE . "}") + (RPAREN . ")")) + ("open-paren" + (LBRACE . "{") + (LPAREN . "(")) + ("block" + (BRACE_BLOCK . "(LBRACE RBRACE)") + (PAREN_BLOCK . "(LPAREN RPAREN)")) + ("code" + (EPILOGUE . "%%...EOF") + (PROLOGUE . "%{...%}")) + ("sexp" + (SEXP)) + ("qlist" + (PREFIXED_LIST)) + ("char" + (CHARACTER)) + ("symbol" + (PERCENT_PERCENT . "\\`%%\\'") + (SYMBOL)) + ("string" + (STRING))) + '(("punctuation" :declared t) + ("block" :declared t) + ("sexp" matchdatatype sexp) + ("sexp" syntax "\\=") + ("sexp" :declared t) + ("qlist" matchdatatype sexp) + ("qlist" syntax "\\s'\\s-*(") + ("qlist" :declared t) + ("char" syntax semantic-grammar-lex-c-char-re) + ("char" :declared t) + ("symbol" syntax ":?\\(\\sw\\|\\s_\\)+") + ("symbol" :declared t) + ("string" :declared t) + ("keyword" :declared t))) + "Table of lexical tokens.") + +(defconst semantic-grammar-wy--parse-table + (wisent-compiled-grammar + ((DEFAULT-PREC NO-DEFAULT-PREC KEYWORD LANGUAGEMODE LEFT NONASSOC PACKAGE EXPECTEDCONFLICTS PROVIDE PREC PUT QUOTEMODE RIGHT SCOPESTART START TOKEN TYPE USE-MACROS STRING SYMBOL PERCENT_PERCENT CHARACTER PREFIXED_LIST SEXP PROLOGUE EPILOGUE PAREN_BLOCK BRACE_BLOCK LPAREN RPAREN LBRACE RBRACE COLON SEMI OR LT GT) + nil + (grammar + ((prologue)) + ((epilogue)) + ((declaration)) + ((nonterminal)) + ((PERCENT_PERCENT))) + (prologue + ((PROLOGUE) + (wisent-raw-tag + (semantic-tag-new-code "prologue" nil)))) + (epilogue + ((EPILOGUE) + (wisent-raw-tag + (semantic-tag-new-code "epilogue" nil)))) + (declaration + ((decl) + (eval $1 t))) + (decl + ((default_prec_decl)) + ((no_default_prec_decl)) + ((languagemode_decl)) + ((package_decl)) + ((expectedconflicts_decl)) + ((provide_decl)) + ((precedence_decl)) + ((put_decl)) + ((quotemode_decl)) + ((scopestart_decl)) + ((start_decl)) + ((keyword_decl)) + ((token_decl)) + ((type_decl)) + ((use_macros_decl))) + (default_prec_decl + ((DEFAULT-PREC) + `(wisent-raw-tag + (semantic-tag "default-prec" 'assoc :value + '("t"))))) + (no_default_prec_decl + ((NO-DEFAULT-PREC) + `(wisent-raw-tag + (semantic-tag "default-prec" 'assoc :value + '("nil"))))) + (languagemode_decl + ((LANGUAGEMODE symbols) + `(wisent-raw-tag + (semantic-tag ',(car $2) + 'languagemode :rest ',(cdr $2))))) + (package_decl + ((PACKAGE SYMBOL) + `(wisent-raw-tag + (semantic-tag-new-package ',$2 nil)))) + (expectedconflicts_decl + ((EXPECTEDCONFLICTS symbols) + `(wisent-raw-tag + (semantic-tag ',(car $2) + 'expectedconflicts :rest ',(cdr $2))))) + (provide_decl + ((PROVIDE SYMBOL) + `(wisent-raw-tag + (semantic-tag ',$2 'provide)))) + (precedence_decl + ((associativity token_type_opt items) + `(wisent-raw-tag + (semantic-tag ',$1 'assoc :type ',$2 :value ',$3)))) + (associativity + ((LEFT) + (progn "left")) + ((RIGHT) + (progn "right")) + ((NONASSOC) + (progn "nonassoc"))) + (put_decl + ((PUT put_name put_value) + `(wisent-raw-tag + (semantic-tag ',$2 'put :value ',(list $3)))) + ((PUT put_name put_value_list) + `(wisent-raw-tag + (semantic-tag ',$2 'put :value ',$3))) + ((PUT put_name_list put_value) + `(wisent-raw-tag + (semantic-tag ',(car $2) + 'put :rest ',(cdr $2) + :value ',(list $3)))) + ((PUT put_name_list put_value_list) + `(wisent-raw-tag + (semantic-tag ',(car $2) + 'put :rest ',(cdr $2) + :value ',$3)))) + (put_name_list + ((BRACE_BLOCK) + (mapcar #'semantic-tag-name + (semantic-parse-region + (car $region1) + (cdr $region1) + 'put_names 1)))) + (put_names + ((LBRACE) + nil) + ((RBRACE) + nil) + ((put_name) + (wisent-raw-tag + (semantic-tag $1 'put-name)))) + (put_name + ((SYMBOL)) + ((token_type))) + (put_value_list + ((BRACE_BLOCK) + (mapcar #'semantic-tag-code-detail + (semantic-parse-region + (car $region1) + (cdr $region1) + 'put_values 1)))) + (put_values + ((LBRACE) + nil) + ((RBRACE) + nil) + ((put_value) + (wisent-raw-tag + (semantic-tag-new-code "put-value" $1)))) + (put_value + ((SYMBOL any_value) + (cons $1 $2))) + (scopestart_decl + ((SCOPESTART SYMBOL) + `(wisent-raw-tag + (semantic-tag ',$2 'scopestart)))) + (quotemode_decl + ((QUOTEMODE SYMBOL) + `(wisent-raw-tag + (semantic-tag ',$2 'quotemode)))) + (start_decl + ((START symbols) + `(wisent-raw-tag + (semantic-tag ',(car $2) + 'start :rest ',(cdr $2))))) + (keyword_decl + ((KEYWORD SYMBOL string_value) + `(wisent-raw-tag + (semantic-tag ',$2 'keyword :value ',$3)))) + (token_decl + ((TOKEN token_type_opt SYMBOL string_value) + `(wisent-raw-tag + (semantic-tag ',$3 ',(if $2 'token 'keyword) + :type ',$2 :value ',$4))) + ((TOKEN token_type_opt symbols) + `(wisent-raw-tag + (semantic-tag ',(car $3) + 'token :type ',$2 :rest ',(cdr $3))))) + (token_type_opt + (nil) + ((token_type))) + (token_type + ((LT SYMBOL GT) + (progn $2))) + (type_decl + ((TYPE token_type plist_opt) + `(wisent-raw-tag + (semantic-tag ',$2 'type :value ',$3)))) + (plist_opt + (nil) + ((plist))) + (plist + ((plist put_value) + (append + (list $2) + $1)) + ((put_value) + (list $1))) + (use_name_list + ((BRACE_BLOCK) + (mapcar #'semantic-tag-name + (semantic-parse-region + (car $region1) + (cdr $region1) + 'use_names 1)))) + (use_names + ((LBRACE) + nil) + ((RBRACE) + nil) + ((SYMBOL) + (wisent-raw-tag + (semantic-tag $1 'use-name)))) + (use_macros_decl + ((USE-MACROS SYMBOL use_name_list) + `(wisent-raw-tag + (semantic-tag "macro" 'macro :type ',$2 :value ',$3)))) + (string_value + ((STRING) + (read $1))) + (any_value + ((SYMBOL)) + ((STRING)) + ((PAREN_BLOCK)) + ((PREFIXED_LIST)) + ((SEXP))) + (symbols + ((lifo_symbols) + (nreverse $1))) + (lifo_symbols + ((lifo_symbols SYMBOL) + (cons $2 $1)) + ((SYMBOL) + (list $1))) + (nonterminal + ((SYMBOL + (setq semantic-grammar-wy--nterm $1 semantic-grammar-wy--rindx 0) + COLON rules SEMI) + (wisent-raw-tag + (semantic-tag $1 'nonterminal :children $4)))) + (rules + ((lifo_rules) + (apply #'nconc + (nreverse $1)))) + (lifo_rules + ((lifo_rules OR rule) + (cons $3 $1)) + ((rule) + (list $1))) + (rule + ((rhs) + (let* + ((nterm semantic-grammar-wy--nterm) + (rindx semantic-grammar-wy--rindx) + (rhs $1) + comps prec action elt) + (setq semantic-grammar-wy--rindx + (1+ semantic-grammar-wy--rindx)) + (while rhs + (setq elt + (car rhs) + rhs + (cdr rhs)) + (cond + ((vectorp elt) + (if prec + (error "Duplicate %%prec in `%s:%d' rule" nterm rindx)) + (setq prec + (aref elt 0))) + ((consp elt) + (if + (or action comps) + (setq comps + (cons elt comps) + semantic-grammar-wy--rindx + (1+ semantic-grammar-wy--rindx)) + (setq action + (car elt)))) + (t + (setq comps + (cons elt comps))))) + (wisent-cook-tag + (wisent-raw-tag + (semantic-tag + (format "%s:%d" nterm rindx) + 'rule :type + (if comps "group" "empty") + :value comps :prec prec :expr action)))))) + (rhs + (nil) + ((rhs item) + (cons $2 $1)) + ((rhs action) + (cons + (list $2) + $1)) + ((rhs PREC item) + (cons + (vector $3) + $1))) + (action + ((PAREN_BLOCK)) + ((PREFIXED_LIST)) + ((BRACE_BLOCK) + (format "(progn\n%s)" + (let + ((s $1)) + (if + (string-match "^{[ \n ]*" s) + (setq s + (substring s + (match-end 0)))) + (if + (string-match "[ \n ]*}$" s) + (setq s + (substring s 0 + (match-beginning 0)))) + s)))) + (items + ((lifo_items) + (nreverse $1))) + (lifo_items + ((lifo_items item) + (cons $2 $1)) + ((item) + (list $1))) + (item + ((SYMBOL)) + ((CHARACTER)))) + (grammar prologue epilogue declaration nonterminal rule put_names put_values use_names)) + "Parser table.") + +(defun semantic-grammar-wy--install-parser () + "Setup the Semantic Parser." + (semantic-install-function-overrides + '((semantic-parse-stream . wisent-parse-stream))) + (setq semantic-parser-name "LALR" + semantic--parse-table semantic-grammar-wy--parse-table + semantic-debug-parser-source "grammar.wy" + semantic-flex-keywords-obarray semantic-grammar-wy--keyword-table + semantic-lex-types-obarray semantic-grammar-wy--token-table) + ;; Collect unmatched syntax lexical tokens + (add-hook 'wisent-discarding-token-functions + #'wisent-collect-unmatched-syntax nil t)) + + +;;; Analyzers +;; +(define-lex-regex-type-analyzer semantic-grammar-wy---regexp-analyzer + "regexp analyzer for tokens." + ":?\\(\\sw\\|\\s_\\)+" + '((PERCENT_PERCENT . "\\`%%\\'")) + 'SYMBOL) + +(define-lex-keyword-type-analyzer semantic-grammar-wy---keyword-analyzer + "keyword analyzer for tokens." + "\\(\\sw\\|\\s_\\)+") + +(define-lex-regex-type-analyzer semantic-grammar-wy---regexp-analyzer + "regexp analyzer for tokens." + semantic-grammar-lex-c-char-re + nil + 'CHARACTER) + +(define-lex-sexp-type-analyzer semantic-grammar-wy---sexp-analyzer + "sexp analyzer for tokens." + "\\s'\\s-*(" + 'PREFIXED_LIST) + +(define-lex-block-type-analyzer semantic-grammar-wy---block-analyzer + "block analyzer for tokens." + "\\s(\\|\\s)" + '((("(" LPAREN PAREN_BLOCK) + ("{" LBRACE BRACE_BLOCK)) + (")" RPAREN) + ("}" RBRACE)) + ) + +(define-lex-string-type-analyzer semantic-grammar-wy---string-analyzer + "string analyzer for tokens." + "\\(\\s.\\|\\s$\\|\\s'\\)+" + '((GT . ">") + (LT . "<") + (OR . "|") + (SEMI . ";") + (COLON . ":")) + 'punctuation) + +(define-lex-sexp-type-analyzer semantic-grammar-wy---sexp-analyzer + "sexp analyzer for tokens." + "\\s\"" + 'STRING) + +(define-lex-sexp-type-analyzer semantic-grammar-wy---sexp-analyzer + "sexp analyzer for tokens." + "\\=" + 'SEXP) + + +;;; Epilogue +;; + + + + +(provide 'semantic/grammar-wy) + +;; Local Variables: +;; version-control: never +;; no-update-autoloads: t +;; End: + +;;; semantic/grammar-wy.el ends here diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index ec1077d447e..641882c9026 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -1,7 +1,6 @@ ;;; eieio-base.el --- Base classes for EIEIO. -*- lexical-binding:t -*- -;;; Copyright (C) 2000-2002, 2004-2005, 2007-2021 Free Software -;;; Foundation, Inc. +;; Copyright (C) 2000-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam ;; Keywords: OO, lisp -- cgit v1.2.3