├── LICENSE ├── README ├── gen_pkgel.sh ├── gen_readme.sh ├── release.sh ├── snitch-backtrace.el ├── snitch-custom.el ├── snitch-filter.el ├── snitch-log.el ├── snitch-test.el ├── snitch-timer.el ├── snitch.el └── test_snitch.sh /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 2, June 1991 3 | 4 | Copyright (C) 1989, 1991 Free Software Foundation, Inc., 5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | Preamble 10 | 11 | The licenses for most software are designed to take away your 12 | freedom to share and change it. By contrast, the GNU General Public 13 | License is intended to guarantee your freedom to share and change free 14 | software--to make sure the software is free for all its users. This 15 | General Public License applies to most of the Free Software 16 | Foundation's software and to any other program whose authors commit to 17 | using it. (Some other Free Software Foundation software is covered by 18 | the GNU Lesser General Public License instead.) You can apply it to 19 | your programs, too. 20 | 21 | When we speak of free software, we are referring to freedom, not 22 | price. Our General Public Licenses are designed to make sure that you 23 | have the freedom to distribute copies of free software (and charge for 24 | this service if you wish), that you receive source code or can get it 25 | if you want it, that you can change the software or use pieces of it 26 | in new free programs; and that you know you can do these things. 27 | 28 | To protect your rights, we need to make restrictions that forbid 29 | anyone to deny you these rights or to ask you to surrender the rights. 30 | These restrictions translate to certain responsibilities for you if you 31 | distribute copies of the software, or if you modify it. 32 | 33 | For example, if you distribute copies of such a program, whether 34 | gratis or for a fee, you must give the recipients all the rights that 35 | you have. You must make sure that they, too, receive or can get the 36 | source code. And you must show them these terms so they know their 37 | rights. 38 | 39 | We protect your rights with two steps: (1) copyright the software, and 40 | (2) offer you this license which gives you legal permission to copy, 41 | distribute and/or modify the software. 42 | 43 | Also, for each author's protection and ours, we want to make certain 44 | that everyone understands that there is no warranty for this free 45 | software. If the software is modified by someone else and passed on, we 46 | want its recipients to know that what they have is not the original, so 47 | that any problems introduced by others will not reflect on the original 48 | authors' reputations. 49 | 50 | Finally, any free program is threatened constantly by software 51 | patents. We wish to avoid the danger that redistributors of a free 52 | program will individually obtain patent licenses, in effect making the 53 | program proprietary. To prevent this, we have made it clear that any 54 | patent must be licensed for everyone's free use or not licensed at all. 55 | 56 | The precise terms and conditions for copying, distribution and 57 | modification follow. 58 | 59 | GNU GENERAL PUBLIC LICENSE 60 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 61 | 62 | 0. This License applies to any program or other work which contains 63 | a notice placed by the copyright holder saying it may be distributed 64 | under the terms of this General Public License. The "Program", below, 65 | refers to any such program or work, and a "work based on the Program" 66 | means either the Program or any derivative work under copyright law: 67 | that is to say, a work containing the Program or a portion of it, 68 | either verbatim or with modifications and/or translated into another 69 | language. (Hereinafter, translation is included without limitation in 70 | the term "modification".) Each licensee is addressed as "you". 71 | 72 | Activities other than copying, distribution and modification are not 73 | covered by this License; they are outside its scope. The act of 74 | running the Program is not restricted, and the output from the Program 75 | is covered only if its contents constitute a work based on the 76 | Program (independent of having been made by running the Program). 77 | Whether that is true depends on what the Program does. 78 | 79 | 1. You may copy and distribute verbatim copies of the Program's 80 | source code as you receive it, in any medium, provided that you 81 | conspicuously and appropriately publish on each copy an appropriate 82 | copyright notice and disclaimer of warranty; keep intact all the 83 | notices that refer to this License and to the absence of any warranty; 84 | and give any other recipients of the Program a copy of this License 85 | along with the Program. 86 | 87 | You may charge a fee for the physical act of transferring a copy, and 88 | you may at your option offer warranty protection in exchange for a fee. 89 | 90 | 2. You may modify your copy or copies of the Program or any portion 91 | of it, thus forming a work based on the Program, and copy and 92 | distribute such modifications or work under the terms of Section 1 93 | above, provided that you also meet all of these conditions: 94 | 95 | a) You must cause the modified files to carry prominent notices 96 | stating that you changed the files and the date of any change. 97 | 98 | b) You must cause any work that you distribute or publish, that in 99 | whole or in part contains or is derived from the Program or any 100 | part thereof, to be licensed as a whole at no charge to all third 101 | parties under the terms of this License. 102 | 103 | c) If the modified program normally reads commands interactively 104 | when run, you must cause it, when started running for such 105 | interactive use in the most ordinary way, to print or display an 106 | announcement including an appropriate copyright notice and a 107 | notice that there is no warranty (or else, saying that you provide 108 | a warranty) and that users may redistribute the program under 109 | these conditions, and telling the user how to view a copy of this 110 | License. (Exception: if the Program itself is interactive but 111 | does not normally print such an announcement, your work based on 112 | the Program is not required to print an announcement.) 113 | 114 | These requirements apply to the modified work as a whole. If 115 | identifiable sections of that work are not derived from the Program, 116 | and can be reasonably considered independent and separate works in 117 | themselves, then this License, and its terms, do not apply to those 118 | sections when you distribute them as separate works. But when you 119 | distribute the same sections as part of a whole which is a work based 120 | on the Program, the distribution of the whole must be on the terms of 121 | this License, whose permissions for other licensees extend to the 122 | entire whole, and thus to each and every part regardless of who wrote it. 123 | 124 | Thus, it is not the intent of this section to claim rights or contest 125 | your rights to work written entirely by you; rather, the intent is to 126 | exercise the right to control the distribution of derivative or 127 | collective works based on the Program. 128 | 129 | In addition, mere aggregation of another work not based on the Program 130 | with the Program (or with a work based on the Program) on a volume of 131 | a storage or distribution medium does not bring the other work under 132 | the scope of this License. 133 | 134 | 3. You may copy and distribute the Program (or a work based on it, 135 | under Section 2) in object code or executable form under the terms of 136 | Sections 1 and 2 above provided that you also do one of the following: 137 | 138 | a) Accompany it with the complete corresponding machine-readable 139 | source code, which must be distributed under the terms of Sections 140 | 1 and 2 above on a medium customarily used for software interchange; or, 141 | 142 | b) Accompany it with a written offer, valid for at least three 143 | years, to give any third party, for a charge no more than your 144 | cost of physically performing source distribution, a complete 145 | machine-readable copy of the corresponding source code, to be 146 | distributed under the terms of Sections 1 and 2 above on a medium 147 | customarily used for software interchange; or, 148 | 149 | c) Accompany it with the information you received as to the offer 150 | to distribute corresponding source code. (This alternative is 151 | allowed only for noncommercial distribution and only if you 152 | received the program in object code or executable form with such 153 | an offer, in accord with Subsection b above.) 154 | 155 | The source code for a work means the preferred form of the work for 156 | making modifications to it. For an executable work, complete source 157 | code means all the source code for all modules it contains, plus any 158 | associated interface definition files, plus the scripts used to 159 | control compilation and installation of the executable. However, as a 160 | special exception, the source code distributed need not include 161 | anything that is normally distributed (in either source or binary 162 | form) with the major components (compiler, kernel, and so on) of the 163 | operating system on which the executable runs, unless that component 164 | itself accompanies the executable. 165 | 166 | If distribution of executable or object code is made by offering 167 | access to copy from a designated place, then offering equivalent 168 | access to copy the source code from the same place counts as 169 | distribution of the source code, even though third parties are not 170 | compelled to copy the source along with the object code. 171 | 172 | 4. You may not copy, modify, sublicense, or distribute the Program 173 | except as expressly provided under this License. Any attempt 174 | otherwise to copy, modify, sublicense or distribute the Program is 175 | void, and will automatically terminate your rights under this License. 176 | However, parties who have received copies, or rights, from you under 177 | this License will not have their licenses terminated so long as such 178 | parties remain in full compliance. 179 | 180 | 5. You are not required to accept this License, since you have not 181 | signed it. However, nothing else grants you permission to modify or 182 | distribute the Program or its derivative works. These actions are 183 | prohibited by law if you do not accept this License. Therefore, by 184 | modifying or distributing the Program (or any work based on the 185 | Program), you indicate your acceptance of this License to do so, and 186 | all its terms and conditions for copying, distributing or modifying 187 | the Program or works based on it. 188 | 189 | 6. Each time you redistribute the Program (or any work based on the 190 | Program), the recipient automatically receives a license from the 191 | original licensor to copy, distribute or modify the Program subject to 192 | these terms and conditions. You may not impose any further 193 | restrictions on the recipients' exercise of the rights granted herein. 194 | You are not responsible for enforcing compliance by third parties to 195 | this License. 196 | 197 | 7. If, as a consequence of a court judgment or allegation of patent 198 | infringement or for any other reason (not limited to patent issues), 199 | conditions are imposed on you (whether by court order, agreement or 200 | otherwise) that contradict the conditions of this License, they do not 201 | excuse you from the conditions of this License. If you cannot 202 | distribute so as to satisfy simultaneously your obligations under this 203 | License and any other pertinent obligations, then as a consequence you 204 | may not distribute the Program at all. For example, if a patent 205 | license would not permit royalty-free redistribution of the Program by 206 | all those who receive copies directly or indirectly through you, then 207 | the only way you could satisfy both it and this License would be to 208 | refrain entirely from distribution of the Program. 209 | 210 | If any portion of this section is held invalid or unenforceable under 211 | any particular circumstance, the balance of the section is intended to 212 | apply and the section as a whole is intended to apply in other 213 | circumstances. 214 | 215 | It is not the purpose of this section to induce you to infringe any 216 | patents or other property right claims or to contest validity of any 217 | such claims; this section has the sole purpose of protecting the 218 | integrity of the free software distribution system, which is 219 | implemented by public license practices. Many people have made 220 | generous contributions to the wide range of software distributed 221 | through that system in reliance on consistent application of that 222 | system; it is up to the author/donor to decide if he or she is willing 223 | to distribute software through any other system and a licensee cannot 224 | impose that choice. 225 | 226 | This section is intended to make thoroughly clear what is believed to 227 | be a consequence of the rest of this License. 228 | 229 | 8. If the distribution and/or use of the Program is restricted in 230 | certain countries either by patents or by copyrighted interfaces, the 231 | original copyright holder who places the Program under this License 232 | may add an explicit geographical distribution limitation excluding 233 | those countries, so that distribution is permitted only in or among 234 | countries not thus excluded. In such case, this License incorporates 235 | the limitation as if written in the body of this License. 236 | 237 | 9. The Free Software Foundation may publish revised and/or new versions 238 | of the General Public License from time to time. Such new versions will 239 | be similar in spirit to the present version, but may differ in detail to 240 | address new problems or concerns. 241 | 242 | Each version is given a distinguishing version number. If the Program 243 | specifies a version number of this License which applies to it and "any 244 | later version", you have the option of following the terms and conditions 245 | either of that version or of any later version published by the Free 246 | Software Foundation. If the Program does not specify a version number of 247 | this License, you may choose any version ever published by the Free Software 248 | Foundation. 249 | 250 | 10. If you wish to incorporate parts of the Program into other free 251 | programs whose distribution conditions are different, write to the author 252 | to ask for permission. For software which is copyrighted by the Free 253 | Software Foundation, write to the Free Software Foundation; we sometimes 254 | make exceptions for this. Our decision will be guided by the two goals 255 | of preserving the free status of all derivatives of our free software and 256 | of promoting the sharing and reuse of software generally. 257 | 258 | NO WARRANTY 259 | 260 | 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 261 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 262 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 263 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED 264 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 265 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS 266 | TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 267 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, 268 | REPAIR OR CORRECTION. 269 | 270 | 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 271 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 272 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 273 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING 274 | OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED 275 | TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY 276 | YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER 277 | PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 278 | POSSIBILITY OF SUCH DAMAGES. 279 | 280 | END OF TERMS AND CONDITIONS 281 | 282 | How to Apply These Terms to Your New Programs 283 | 284 | If you develop a new program, and you want it to be of the greatest 285 | possible use to the public, the best way to achieve this is to make it 286 | free software which everyone can redistribute and change under these terms. 287 | 288 | To do so, attach the following notices to the program. It is safest 289 | to attach them to the start of each source file to most effectively 290 | convey the exclusion of warranty; and each file should have at least 291 | the "copyright" line and a pointer to where the full notice is found. 292 | 293 | 294 | Copyright (C) 295 | 296 | This program is free software; you can redistribute it and/or modify 297 | it under the terms of the GNU General Public License as published by 298 | the Free Software Foundation; either version 2 of the License, or 299 | (at your option) any later version. 300 | 301 | This program is distributed in the hope that it will be useful, 302 | but WITHOUT ANY WARRANTY; without even the implied warranty of 303 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 304 | GNU General Public License for more details. 305 | 306 | You should have received a copy of the GNU General Public License along 307 | with this program; if not, write to the Free Software Foundation, Inc., 308 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 309 | 310 | Also add information on how to contact you by electronic and paper mail. 311 | 312 | If the program is interactive, make it output a short notice like this 313 | when it starts in an interactive mode: 314 | 315 | Gnomovision version 69, Copyright (C) year name of author 316 | Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 317 | This is free software, and you are welcome to redistribute it 318 | under certain conditions; type `show c' for details. 319 | 320 | The hypothetical commands `show w' and `show c' should show the appropriate 321 | parts of the General Public License. Of course, the commands you use may 322 | be called something other than `show w' and `show c'; they could even be 323 | mouse-clicks or menu items--whatever suits your program. 324 | 325 | You should also get your employer (if you work as a programmer) or your 326 | school, if any, to sign a "copyright disclaimer" for the program, if 327 | necessary. Here is a sample; alter the names: 328 | 329 | Yoyodyne, Inc., hereby disclaims all copyright interest in the program 330 | `Gnomovision' (which makes passes at compilers) written by James Hacker. 331 | 332 | , 1 April 1989 333 | Ty Coon, President of Vice 334 | 335 | This General Public License does not permit incorporating your program into 336 | proprietary programs. If your program is a subroutine library, you may 337 | consider it more useful to permit linking proprietary applications with the 338 | library. If this is what you want to do, use the GNU Lesser General 339 | Public License instead of this License. 340 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | snitch.el (pronounced like schnitzel) is a firewall for Emacs. 2 | 3 | snitch intercepts calls to create network connections or launch 4 | subprocesses. Through user-configured default policies, filter 5 | rules, and user hooks it is able to log and potentially block each 6 | action. It can be configured with ‘M-x customize-group 7 | snitch’. 8 | 9 | Subprocesses and network connections are handled independently, 10 | with their own separate default policies, blacklist and whitelist, 11 | and logging policies. 12 | 13 | The main purpose of snitch is network monitoring. Subprocesses are 14 | included because it is extremely common for Emacs packages to 15 | "shell out" to an external program for network access, commonly to 16 | ‘curl’. As a side effect, snitch can also effectively audit and 17 | prevent undesired access to other programs. 18 | 19 | Notifications can be raised on each logged event by ensuring the 20 | ’alert’ package is installed and customizing 21 | ‘snitch-enable-notifications’ to t. 22 | 23 | 24 | === WHY? === 25 | 26 | Emacs is a general-purpose execution environment, executing with 27 | the full privileges of whichever user launched it. It can read and 28 | create files, obviously, but also spawn external programs, open 29 | network connections, and communicate through pipes. In modern 30 | times, most users manage large collections of third-party packages 31 | through intelligent package managers that automatically pull in any 32 | number of dependencies, updated periodically. Any and all of these 33 | could be a bit naughty, and the sheer quantity of Lisp code in a 34 | modern Emacs install makes it un-auditable. 35 | 36 | An Emacs firewall, thus, makes sense. Does *snitch* make sense? 37 | Not really... see the SECURITY section below. But we currently 38 | have nothing, and snitch is better than nothing. 39 | 40 | Also, to answer the question: "I wonder if I can make an Emacs 41 | firewall?" Yes! ...well, sort of. 42 | 43 | 44 | === MECHANISM === 45 | 46 | The underlying ’firewall’ mechanism is built on function advice 47 | surrounding Emacs’s lowest-level core functions for spawning 48 | connections or subprocesses. When an Emacs package or script makes 49 | such a request, snitch receives it first, and either passes it 50 | through or rejects it based on the current rules. Once a 51 | connection or process is accepted, snitch is no longer involved for 52 | the duration of that particular communication stream. 53 | 54 | For each intercepted call, snitch first builds an event object 55 | defining everything snitch knows about the call. The metadata 56 | differs for network connections (host, port, family) and processes 57 | (executable and argument list), but all events share a common set: 58 | calling function, calling function’s file path, calling package, 59 | and request name. 60 | 61 | Once an event object is created, it is passed to any hooks defined 62 | in ‘snitch-on-event-functions’ for early processing. If a hook 63 | returns nil, the event is dropped immediately. Otherwise, snitch 64 | then checks the corresponding whitelist (if the default policy is 65 | deny) or the blacklist (if the default policy is allow) and makes 66 | its internal decision. Before executing the decision, it calls the 67 | corresponding hook functions to give the user hooks one more 68 | opportunity to change the decision. Finally, only if the decision 69 | was ‘allow’, snitch executes the original request and passes the 70 | result back to the caller. 71 | 72 | As the event flows through the decision tree, it also triggers log 73 | events. There are several different types defined in 74 | ‘snitch-log-policies’, and users can subscribe to any combination 75 | of them by customizing ‘snitch-log-policy’. Logs are displayed in 76 | text format in a dedicated log buffer (by default: ‘*snitch 77 | firewall log*’), along with text properties that allow extracting 78 | the event information programatically from a log line with 79 | ‘get-text-property’. The text lines can be "pretty printed" by 80 | customizing ‘snitch-log-verbose’. 81 | 82 | An example log entry is below, split to several lines for display. 83 | In the actual log, non-verbose logs are a single line. 84 | 85 | > [2020-12-03 00:16:50] (whitelisted) -- #s(snitch-network-entry \ 86 | > 1606951010.2966838 helm-M-x-execute-command \ 87 | > /home/trevor/.emacs.d/elpa/helm-20201019.715/helm-command.el \ 88 | > helm 127.0.0.1 127.0.0.1 64222 nil) 89 | 90 | With `snitch-log-verbose' enabled, log entries actually do take 91 | several lines: 92 | 93 | > [2020-12-03 01:11:27] (blocked) -- 94 | > (snitch-network-entry "snitch-network-entry-157d34506664" 95 | > 96 | > :timestamp 1606954287.770638 97 | > :src-fn snitch--wrap-make-network-process 98 | > :src-path "/home/trevor/.emacs.d/snitch/snitch.el" 99 | > :src-pkg user 100 | > :proc-name "google.com" 101 | > :host "google.com" 102 | > :port 80) 103 | 104 | 105 | === GETTING SNITCH === 106 | 107 | snitch is published in the MELPA package repository. The recommend 108 | installation method is via an Emacs package manager that supports 109 | MELPA. 110 | 111 | use-package: 112 | 113 | > (use-package snitch :ensure t) 114 | 115 | straight.el: 116 | 117 | > (straight-use-package 'snitch) 118 | 119 | manually: 120 | 121 | > (require 'package) 122 | > (add-to-list 'package-archives 123 | > '("melpa" . "https://melpa.org/packages/")) 124 | > (unless (package-installed-p 'snitch) 125 | > (package-install 'snitch)) 126 | > (require 'snitch) 127 | 128 | 129 | It can also be installed by any package manager that supports git 130 | repositories, or manually via tarball. 131 | 132 | quelpa: 133 | 134 | > (quelpa '(snitch :repo "mrmekon/snitch-el" :fetcher github)) 135 | 136 | use-package + quelpa + quelpa-use-package: 137 | 138 | > (use-package snitch 139 | > :quelpa (snitch :repo "mrmekon/snitch-el" :fetcher github)) 140 | 141 | el-get: 142 | 143 | > (el-get-bundle mrmekon/snitch-el) 144 | 145 | straight.el: 146 | 147 | > (straight-use-package 148 | > '(snitch :type git :host github :repo "mrmekon/snitch-el")) 149 | 150 | manual: 151 | 152 | > (package-install-file "/path/to/snitch-x.y.z.tar") 153 | 154 | 155 | === USAGE === 156 | 157 | Enabling snitch is as simple as calling ‘snitch-mode’ 158 | interactively, or ‘(snitch-mode +1)’ from your init file. 159 | Initialization does very little, so this is safe to call in your 160 | Emacs init without worrying about deferral or negative consequences 161 | on startup time. 162 | 163 | The minimum required initialization is simply: 164 | 165 | > (require 'snitch) 166 | > (snitch-mode +1) 167 | 168 | An example initialization using ‘use-package’ might look like so: 169 | 170 | > (use-package snitch 171 | > :config 172 | > (snitch-mode +1)) 173 | 174 | snitch then runs in the background, performing its duties according 175 | to your configuration, and logging in its dedicated buffer. 176 | 177 | You may add firewall exception rules manually, as covered in the 178 | CONFIGURATION section below. Alternatively, you can also build 179 | filters with a guided UI by switching to the firewall log buffer 180 | (‘*snitch firewall log*’), highlighting an entry that you wish to 181 | filter on, and execute ‘M-x snitch-filter-from-log’. This launches 182 | a popup window that allows you to configure a new filter based on 183 | one or more fields of the selected log line, and add it to either 184 | your blacklist or whitelist. 185 | 186 | To disable snitch, call ‘snitch-mode’ interactively, or 187 | ‘(snitch-mode -1)’ programmatically. You can restart snitch with 188 | ‘snitch-restart’. 189 | 190 | 191 | === CONFIGURATION === 192 | 193 | Customize snitch with ‘M-x customize-group snitch’, or 194 | manually in your Emacs initialization file. 195 | 196 | Most users will have five variables that need to be configured 197 | before use: 198 | 199 | - ‘snitch-network-policy’ -- whether to allow or deny network 200 | connections by default. 201 | 202 | - ‘snitch-process-policy’ -- whether to allow or deny subprocesses 203 | by default. 204 | 205 | - ‘snitch-log-policy’ -- which events to log (to see the options, 206 | run ‘M-x describe-variable snitch-log-policies’) 207 | 208 | - ‘snitch-network-*list’ -- filter rules containing exceptions to 209 | the default network policy. See FILTER RULES below. Use 210 | ‘-whitelist’ if the default policy is ‘deny’, or ‘-blacklist’ if 211 | the default policy is ‘allow’ 212 | 213 | - ‘snitch-process-*list’ -- filter rules containing exceptions to 214 | the default process policy. See FILTER RULES below. Use 215 | ‘-whitelist’ if the default policy is ‘deny’, or ‘-blacklist’ if 216 | the default policy is ‘allow’ 217 | 218 | 219 | Have a look in ‘snitch-filter.el’ for examples of black/whitelist 220 | filters, and in ‘snitch-test.el’ for contrived examples of pretty 221 | much everything. 222 | 223 | 224 | ==== COMMON CONFIG: DENY ==== 225 | 226 | A useful configuration is to deny all external communication by 227 | default, but allow certain packages to communicate. This example 228 | demonstrates permitting only the ’elfeed’ package to create network 229 | connections: 230 | 231 | > (use-package snitch 232 | > :config 233 | > (setq snitch-network-policy 'deny) 234 | > (setq snitch-process-policy 'deny) 235 | > (setq snitch-log-policy '(blocked whitelisted allowed)) 236 | > (add-to-list 'snitch-network-whitelist 237 | > (cons #'snitch-filter-src-pkg '(elfeed))) 238 | > (snitch-mode +1)) 239 | 240 | 241 | ==== COMMON CONFIG: ALLOW + AUDIT ==== 242 | 243 | Another useful configuration is to allow all accesses, but log them 244 | to keep an audit trail. This might look like so: 245 | 246 | > (use-package snitch 247 | > :config 248 | > (setq snitch-network-policy 'allow) 249 | > (setq snitch-process-policy 'allow) 250 | > (setq snitch-log-policy '(allowed blocked whitelisted blacklisted)) 251 | > (setq snitch-log-verbose t) 252 | > (snitch-mode +1)) 253 | 254 | 255 | ==== FILTER RULES ==== 256 | 257 | Filter rules, as specified in ‘snitch-(process|network)-*list’ 258 | variables, are specified as cons cells where the car is a filtering 259 | function, and the cdr is a list of arguments to pass to the 260 | function in addition to the event object: 261 | 262 | > (setq snitch-network-whitelist 263 | > '( 264 | > (filter-fn1 . (argQ)) 265 | > (filter-fn2 . (argN argP)) 266 | > )) 267 | 268 | Each filter function should have a prototype accepting EVENT as the 269 | snitch event object in consideration, and ARGS as the list of 270 | arguments from the cdr of the rules entry: 271 | 272 | > (defun filter-fn1 (event &rest args)) 273 | 274 | EVENT is an eieio object defined by ‘snitch-network-entry’ or 275 | ‘snitch-process-entry’, and inheriting from ‘snitch-source’. 276 | 277 | A trivial function which matches if a single string in the event 278 | object matches a known value might look like so: 279 | 280 | > (defun filter-fn1 (event name) 281 | > (string-equal (oref event proc-name) name)) 282 | 283 | While a more complex filter function might treat ARGS as an 284 | associative list of key/value pairs: 285 | 286 | > (defun filter-fn2 (event &rest alist) 287 | > (cl-loop for (aslot . avalue) in alist with accept = t 288 | > do 289 | > (let ((evalue (eieio-oref event aslot)) 290 | > (val-type (type-of avalue))) 291 | > (unless (cond 292 | > ((eq val-type 'string) (string-equal avalue evalue)) 293 | > (t (eq avalue evalue))) 294 | > (setq accept nil))) 295 | > when (null accept) 296 | > return nil 297 | > finally return accept)) 298 | 299 | The return value of a filter function determines whether the filter 300 | should take effect. t means "take effect" and nil means "do not 301 | take effect". What that means for the event depends on which list 302 | the filter rule is in. If the rule is in a whitelist, t means 303 | allow and nil means block. If it is in a blacklist, t means block 304 | and nil means allow. 305 | 306 | 307 | ==== HOOKS ==== 308 | 309 | Events are passed to user-provided hook functions, if specified. 310 | These hooks can subscribe to receive events either immediately on 311 | arrival, upon a final decision, or both. The hooks can change 312 | snitch’s final decision. 313 | 314 | Hook functions take two arguments, the type and the event object: 315 | 316 | > (defun snitch-hook (type event)) 317 | 318 | TYPE is one of `snitch-hook-types', and corresponds with the names 319 | of the hook lists. This argument is provided so you can define one 320 | function which can be used in several hooks. 321 | 322 | EVENT is an eieio object defined by ‘snitch-network-entry’ or 323 | ‘snitch-process-entry’, and inheriting from ‘snitch-source’. 324 | 325 | Hooks should return t to allow snitch to continue processing as it 326 | would have, or return nil to reverse snitch’s decision. For hooks 327 | in ‘snitch-on-event-functions’, returning nil cancels all further 328 | processing of the event and blocks it immediately. For other hook 329 | lists, returning nil reverses the action implied by the list name: 330 | returning nil in a ‘snitch-on-allow-functions’ hook causes the 331 | event to be blocked, returning nil in a ‘snitch-on-block-functions’ 332 | hook causes it to be allowed. 333 | 334 | 335 | snitch also supports filtering log entries with hooks via 336 | ‘snitch-log-functions’. These hooks can pass, block, or modify 337 | entries before they are printed in the snitch log. See ‘M-x 338 | describe-variable snitch-log-functions’ for details. 339 | 340 | snitch also calls hooks when it starts (‘snitch-init-hook’), shuts 341 | down (‘snitch-deinit-hook’), or opens or closes the log filter 342 | window (‘snitch-log-filter-window-open-hook’, 343 | ‘snitch-log-filter-window-close-hook’). 344 | 345 | 346 | === PERFORMANCE === 347 | 348 | Performance has not been measured, and should not be assumed to be 349 | particularly good. Nothing is currently optimized. 350 | 351 | Memory usage should not be particularly high, as events are 352 | ephemeral and only contain a small amount of metadata. The largest 353 | use of memory is the audit log, which does keep copies of all 354 | events in the log. This can be controlled via 355 | ‘snitch-log-buffer-max-lines’. 356 | 357 | Firewall rules are traversed linearly, and short-circuit (if an 358 | early rule terminates processing, the subsequent rules will not be 359 | considered). To optimize for performance, the total number of 360 | rules should be kept to a minimum, and most likely to match rules 361 | should be added earlier in the lists. 362 | 363 | 364 | === TIMER TRACING === 365 | 366 | Since snitch’s usefulness is highly dependent on the ability to 367 | trace back to the original source that triggered an event, Emacs 368 | timers pose a bit of a challenge. Timers are used to trigger 369 | network requests asynchronously, but have the side effect of losing 370 | the stack trace back to the function or package that initiated it. 371 | 372 | To deal with this, snitch optionally supports timer tracing. When 373 | tracing is enabled, by customizing ‘snitch-trace-timers’ to t, 374 | snitch hooks into Emacs’s timer functions, and records backtraces 375 | whenever a timer is registered. If a timer later generates a 376 | snitch-relevant event, snitch concatenates the regular backtrace 377 | with the cached timer backtrace to get a full call stack for the 378 | event. 379 | 380 | As an example, here are two snitch log entries when opening RSS 381 | feeds with the elfeed package, which uses timers for web requests: 382 | 383 | With ‘snitch-trace-timers’ set to nil (tracing disabled): 384 | 385 | > [2020-12-07 21:32:56] (allowed) -- #s(snitch-network-entry \ 386 | > 1607373176.6757963 \ 387 | > timer-event-handler \ 388 | > /usr/share/emacs/27.1/lisp/emacs-lisp/timer.el \ 389 | > site-lisp \ 390 | > www.smbc-comics.com www.smbc-comics.com 443 nil) 391 | 392 | Notice how the source is the function ‘timer-event-handler’ in 393 | ‘timer.el’, part of the special ‘site-lisp’ package? *All* 394 | timer-originated network calls appear to originate from that 395 | function, since it is the lowest level Emacs timer dispatch 396 | function. It is impossible to filter on the true source. 397 | 398 | Now with ‘snitch-trace-timers’ set to t (tracing enabled): 399 | 400 | > [2020-12-07 21:33:06] (allowed) -- #s(snitch-network-entry \ 401 | > 1607373186.6863618 \ 402 | > elfeed-insert-html 403 | > /home/trevor/.emacs.d/elpa/elfeed-20200910.239/elfeed-show.el \ 404 | > elfeed \ 405 | > www.smbc-comics.com www.smbc-comics.com 443 nil) 406 | 407 | For this event, snitch has successfully traced through the timer to 408 | find the true source, ‘elfeed-insert-html’ in the ‘elfeed’ package! 409 | 410 | Timer tracing comes with a cost: snitch has to generate metadata 411 | for every single timer event. If your Emacs usage involves a very 412 | large number of timers, or very high-frequency timers, snitch’s 413 | tracing could lead to delays and inflated memory usage. Consider 414 | carefully whether this is a feature you need, and leave it disabled 415 | if you will not use it, or if you experience any performance issues 416 | while running snitch. 417 | 418 | You can run ‘snitch-monitor-unique-timer-fns’ to get a sense of 419 | which timers are currently active. After running that function, 420 | there will be a 60 second delay, followed by printing the names of 421 | all timers that were active during the minute and the number of 422 | times they fired. 423 | 424 | Similarly, if you run with timer tracing enabled for a while, you 425 | can use ‘snitch--debug-print-timer-state’ to print a summary of how 426 | many timers snitch has intercepted, and how many saved backtraces 427 | are currently active in memory. 428 | 429 | 430 | === SECURITY === 431 | 432 | snitch provides, effectively, zero security. 433 | 434 | If you were to ask your Principal Security Engineer friends, they 435 | might say that an effective security boundary must be 436 | "tamper-proof" and provide "complete mediation." snitch does 437 | neither. 438 | 439 | Tamper-proof: none at all. Any other Emacs package can simply 440 | disable snitch, or modify it to pass malicious traffic undetected. 441 | 442 | Complete mediation: no attempt has been made to verify that *all* 443 | network and subprocess accesses must go through the functions that 444 | snitch hooks. Given the complexity of Emacs, it is extremely 445 | unlikely that they do. 446 | 447 | However, your Principal Security Engineer friends also like to 448 | blather on about ’defining your security model’, and a fun game to 449 | play with them is to define your security model such that none of 450 | the insecurities are in it. As so: 451 | 452 | Security model: includes malicious adversaries 453 | snitch effectiveness: zero. 454 | 455 | Security model: includes no malicious adversaries 456 | snitch effectiveness: great! 457 | 458 | snitch is useful for auditing and blocking unwanted features in an 459 | otherwise well-behaving ecosystem. It is handy for getting a 460 | record of exactly what your Emacs is doing, and for fine-tuning 461 | accesses beyond Emacs’s boundaries a little bit better. It will 462 | not, however, save you from the bad guys. 463 | 464 | 465 | === KNOWN LIMITATIONS === 466 | 467 | When snitch blocks events, some Emacs functions that seldom throw 468 | errors in normal use will throw errors because of snitch. It is 469 | very likely that blocked connections will cause errors to bubble up 470 | in strange and unexpected ways, as many package authors have not 471 | handled these exceptional cases. 472 | 473 | snitch does not intercept domain name resolution (DNS). 474 | 475 | snitch has a strong preference for identifying user-provided 476 | packages as the "originating source" of events. Events that you 477 | may consider as originated in built-in/site-lisp code may be 478 | attributed to a user package instead, if one is higher up in the 479 | backtrace. For instance, `helm' may often show up as the source if 480 | installed, since `helm-M-x-execute-command' is often somewhere in 481 | the stack. 482 | 483 | snitch has not been tested with IPv6. 484 | 485 | snitch has not been tested with inbound connections. In theory, it 486 | can prevent the creation of a listening socket. Once a socket is 487 | open, though, it would not be able to monitor incoming connections 488 | to the socket. 489 | 490 | 491 | === TODO === 492 | 493 | - send notifications in batches? 494 | - interactive prompts? 495 | - handle service strings as port numbers 496 | - ensure the inverted negation rules make sense 497 | - add blacklist for timer functions 498 | - profit! 499 | 500 | 501 | === VERSION HISTORY === 502 | 503 | v0.3.1 (development) 504 | 505 | v0.3.0 (2021-02-02) 506 | 507 | - published on MELPA 508 | - make snitch a global minor mode 509 | - introduce (snitch-mode) 510 | - make (snitch-init) private (snitch--init) 511 | - make (snitch-deinit) private (snitch--deinit) 512 | - add init and deinit hooks 513 | - customizable keymap for log filter wizard 514 | - fixed several byte compiler warnings 515 | 516 | v0.2.0 (2020-12-09) 517 | 518 | - first published version 519 | 520 | v0.1.0 (before 2020-12-09) 521 | 522 | - Initial development and testing 523 | - Network and process firewall functionality 524 | - Audit logging 525 | - Whitelist + blacklist filtering 526 | - Backtrace processing 527 | - Timer backtrace expansion 528 | - User event and logging hooks 529 | - ert test framework 530 | 531 | 532 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 533 | 534 | This program is free software; you can redistribute it and/or modify 535 | it under the terms of the GNU General Public License as published by 536 | the Free Software Foundation; either version 2, or (at your option) 537 | any later version. 538 | 539 | This program is distributed in the hope that it will be useful, 540 | but WITHOUT ANY WARRANTY; without even the implied warranty of 541 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 542 | GNU General Public License for more details. 543 | 544 | You should have received a copy of the GNU General Public License 545 | along with this program; see the file COPYING. If not, write to 546 | the Free Software Foundation, Inc., 51 Franklin Street, Fifth 547 | Floor, Boston, MA 02110-1301, USA. 548 | 549 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 550 | 551 | -------------------------------------------------------------------------------- /gen_pkgel.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | set -eux 3 | 4 | cat < snitch-pkg.el 5 | (define-package 6 | "snitch" 7 | "0.3.1" 8 | "A firewall for emacs." 9 | '((emacs "27.1"))) 10 | EOF 11 | -------------------------------------------------------------------------------- /gen_readme.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | cat snitch.el \ 3 | | awk 'f&&f++&&f>2;/^;;; Commentary/{f=1};/^;;; Code/{f=0}' \ 4 | | sed \$d \ 5 | | sed 's/^;;[ ]\?//' \ 6 | > README 7 | -------------------------------------------------------------------------------- /release.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | set -eux 3 | 4 | VERSION=$(cat snitch.el |grep ";; Version:" | sed 's/.*: //') 5 | PKG="snitch-$VERSION" 6 | 7 | sh test_snitch.sh 8 | if [[ $? -ne 0 ]]; then 9 | echo "Automated tests failed, not releasing." 10 | exit 1 11 | fi 12 | rm *.elc 13 | mkdir -p "$PKG" 14 | sh gen_readme.sh 15 | sh gen_pkgel.sh 16 | cp snitch*.el "$PKG" 17 | rm "$PKG/snitch-test.el" 18 | cp README "$PKG" 19 | tar -cf "$PKG.tar" "$PKG" 20 | tar -tf "$PKG.tar" 21 | rm snitch-pkg.el 22 | 23 | if [[ "x$PKG" != "x" ]]; then 24 | rm -rf "$PKG" 25 | fi 26 | echo "Released $PKG" 27 | -------------------------------------------------------------------------------- /snitch-backtrace.el: -------------------------------------------------------------------------------- 1 | ;;; snitch-backtrace.el --- -*- lexical-binding: t; -*- 2 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3 | ;; 4 | ;; See snitch.el for full details. 5 | ;; 6 | ;; Copyright (C) 2020 Trevor Bentley 7 | ;; Author: Trevor Bentley 8 | ;; URL: https://github.com/mrmekon/snitch-el 9 | ;; 10 | ;; This file is not part of GNU Emacs. 11 | ;; 12 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13 | ;; 14 | ;;; Commentary: 15 | ;; 16 | ;; This file provides backtrace analysis for snitch.el. It is used to 17 | ;; attempt to determine the most likely original source of an event. 18 | ;; 19 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 20 | ;; 21 | ;; This program is free software; you can redistribute it and/or modify 22 | ;; it under the terms of the GNU General Public License as published by 23 | ;; the Free Software Foundation; either version 2, or (at your option) 24 | ;; any later version. 25 | ;; 26 | ;; This program is distributed in the hope that it will be useful, 27 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 28 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 29 | ;; GNU General Public License for more details. 30 | ;; 31 | ;; You should have received a copy of the GNU General Public License 32 | ;; along with this program; see the file COPYING. If not, write to 33 | ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth 34 | ;; Floor, Boston, MA 02110-1301, USA. 35 | ;; 36 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 37 | ;; 38 | ;;; Code: 39 | (require 'cl-lib) ; cl loops 40 | (require 'package) ; backtrace package sources 41 | (require 'backtrace) 42 | 43 | (require 'snitch-custom) 44 | (require 'snitch-timer) 45 | 46 | ;; Since the backtrace functions might be called extremely often, 47 | ;; particularly when timer tracing is enabled, much of the metadata 48 | ;; needed to flesh out backtraces is cached on first use. This 49 | ;; optimization brought execution time for (snitch--backtrace) down 50 | ;; from 20ms to 1ms on my (quite fast) machine. 51 | ;; 52 | ;; TODO: invalidate, refresh, or limit size of these caches? 53 | ;; snitch--package-dirs-cache might grow unbounded. 54 | 55 | (defvar snitch--site-lisp-dir-cache nil 56 | "Cache a list of the Emacs site-lisp directories.") 57 | 58 | (defvar snitch--site-lisp-root-cache nil 59 | "Cache a list of the Emacs site-lisp root directories.") 60 | 61 | (defvar snitch--function-to-file-cache nil 62 | "Cache of function-to-file mappings. 63 | 64 | Hash table cache of function names to the file the functions are 65 | defined in.") 66 | 67 | (defvar snitch--package-dirs-cache '() 68 | "Cache of elisp package directories. 69 | 70 | Hash table cache mapping elisp directories to active packages.") 71 | 72 | 73 | (defun snitch--fn-hash-cmp (a b) 74 | "Hash comparison for function/package cache. 75 | 76 | Hash comparison function for function/package hash table, 77 | since functions can be either function objects or strings and 78 | require different comparisons. 79 | 80 | Return t if A equals B." 81 | (if (and (functionp a) (functionp b)) 82 | (eq a b) 83 | (equal a b))) 84 | 85 | (defun snitch--find-function-file (fn) 86 | "Find file owning function FN. 87 | 88 | Look up the file a function is defined in, caching it in a 89 | hash table for quicker subsequent accesses." 90 | (unless snitch--function-to-file-cache 91 | (define-hash-table-test 'snitch-fn-hash-cmp 92 | #'snitch--fn-hash-cmp #'sxhash-equal) 93 | (setq snitch--function-to-file-cache 94 | (make-hash-table :test 'snitch-fn-hash-cmp))) 95 | (let ((stored-file (gethash fn snitch--function-to-file-cache))) 96 | (if stored-file (if (eq stored-file 'notfound) nil 97 | stored-file) 98 | (let ((file (find-lisp-object-file-name fn 'defun))) 99 | (if file 100 | (puthash fn file snitch--function-to-file-cache) 101 | (progn 102 | (puthash fn 'notfound snitch--function-to-file-cache) 103 | nil)))))) 104 | 105 | (defun snitch--site-lisp-dirs () 106 | "Find site-lisp directories. 107 | 108 | Find all directories in elisp load path that are not in the user 109 | dir." 110 | (if (not snitch--site-lisp-dir-cache) 111 | (let* ((user-dir (expand-file-name user-emacs-directory)) 112 | (pkg-dir (expand-file-name package-user-dir)) 113 | (dirs 114 | (cl-loop for dir in (elisp-load-path-roots) 115 | unless (or 116 | (string-prefix-p user-dir dir) 117 | (string-prefix-p pkg-dir dir) 118 | (string-prefix-p package-user-dir dir) 119 | (string-prefix-p user-emacs-directory dir)) 120 | collect dir))) 121 | (setq snitch--site-lisp-dir-cache dirs) 122 | dirs) 123 | snitch--site-lisp-dir-cache)) 124 | 125 | (defun snitch--site-lisp-roots () 126 | "Find the root site-lisp directories. 127 | 128 | Find the 'root' directories, hopefully a list of 129 | system-wide/non-user base directories containing elisp files." 130 | (if (not snitch--site-lisp-root-cache) 131 | (let ((dirs 132 | (cl-loop for dir in (snitch--site-lisp-dirs) 133 | if (or (string-equal "lisp" (file-name-base dir)) 134 | (string-equal "site-lisp" (file-name-base dir))) 135 | collect dir))) 136 | (setq snitch--site-lisp-root-cache dirs) 137 | dirs) 138 | snitch--site-lisp-root-cache)) 139 | 140 | (defun snitch--dir-in-site-lisp (dir) 141 | "Check if DIR is in a site-lisp directory. 142 | 143 | Check if directory DIR is a subdirectory of one of the 144 | system-wide elisp directories found by 145 | `snitch--site-lisp-roots'." 146 | (not (null (cl-loop for site-dir in (snitch--site-lisp-roots) 147 | if (string-prefix-p site-dir dir) 148 | collect site-dir)))) 149 | 150 | (defun snitch--fill-package-dirs-cache () 151 | "Fill package directory cache. 152 | 153 | Cache package directories in a hash table for faster subsequent 154 | accesses." 155 | (setq snitch--package-dirs-cache 156 | (make-hash-table :test 'equal :size (length (package--alist)))) 157 | (cl-loop for (pkgname . pkgdesc) in (package--alist) 158 | do 159 | (puthash (file-name-as-directory (package-desc-dir (car pkgdesc))) 160 | pkgname 161 | snitch--package-dirs-cache)) 162 | (hash-table-count snitch--package-dirs-cache)) 163 | 164 | (defun snitch--package-from-dir (dir) 165 | "Find package that owns directory DIR. 166 | 167 | Given a directory DIR, returns a package that owns the files in 168 | that directory." 169 | (unless snitch--package-dirs-cache 170 | (snitch--fill-package-dirs-cache)) 171 | (gethash (file-name-as-directory dir) snitch--package-dirs-cache)) 172 | 173 | (defun snitch--package-from-path (path) 174 | "Try to guess a package name for PATH, a full path to a file. 175 | Returns a symbol, which is either an installed package name, or 176 | one of the following special values: 177 | 178 | - `built-in' -- registered as a built-in package 179 | - `site-lisp' -- found in a system-wide elisp directory 180 | - `user' -- unknown source" 181 | (let* ((dir (file-name-directory path)) 182 | ;; twice to handle .el.gz 183 | (base (file-name-base (file-name-base path))) 184 | (package (snitch--package-from-dir dir))) 185 | (if package 186 | package 187 | (if (package-built-in-p (intern base)) 188 | 'built-in 189 | (if (snitch--dir-in-site-lisp dir) 190 | 'site-lisp 191 | 'user))))) 192 | 193 | (defun snitch--maybe-add-timer-backtrace (bt timer) 194 | "Try to add a saved timer backtrace to current backtrace. 195 | 196 | If the given backtrace BT terminates in the timer execution 197 | handler, check if snitch has cached the backtrace for the 198 | executing timer, TIMER, and append that backtrace to BT." 199 | (let ((last-fn (nth 0 (car bt))) 200 | (reverse-bt (nreverse bt))) 201 | (if (eq last-fn #'timer-event-handler) 202 | ;; timer event, concatenate backtraces 203 | (let ((t-bt (snitch--get-timer-backtrace timer))) 204 | (nconc reverse-bt t-bt)) 205 | ;; not a timer event 206 | reverse-bt))) 207 | 208 | (defun snitch--backtrace (&optional follow-timer) 209 | "Return a backtrace usable by snitch. 210 | 211 | Return a full list of backtrace entries (the full function call 212 | stack) where each entry is a list containing (FUNCTION PATH 213 | PACKAGE). Entries related to the snitch callstack are filtered 214 | out. 215 | 216 | FUNCTION is a function symbol if available, or one of the special 217 | symbols ‘lambda’, ‘macro’, or ‘compiled-function’ otherwise. 218 | 219 | PATH is the full path to the file FUNCTION is defined in, if 220 | known. 221 | 222 | PACKAGE is the package that FUNCTION is defined in, or one of the 223 | special symbols ‘built-in’, ‘site-lisp’, ‘user’, or nil if 224 | unknown. 225 | 226 | FOLLOW-TIMER tells snitch to attempt to reconstruct a longer 227 | backtrace if this one originated from a timer callback. 228 | ‘snitch-trace-timers’ must be t for this to have any effect. If 229 | it is enabled, and a matching timer is found, the backtraces are 230 | concatenated together." 231 | (let* ((stack '()) 232 | (timer-args nil) 233 | (frames (backtrace-get-frames)) 234 | ;; 5 is the magic number of frames to skip out of the 235 | ;; snitch-related calls (0 indexed, so idx > 4): 236 | ;; 237 | ;; 1) backtrace-get-frames 238 | ;; 2) let (here in snitch--backtrace) 239 | ;; 3) snitch--backtrace 240 | ;; 4) let* (in snitch wrapper functions) 241 | ;; 5) snitch wrapper fn (ex: snitch--wrap-make-network-process) 242 | ;; 243 | ;; This only works correctly if all of snitch’s hooking 244 | ;;functions immediately call (snitch-backtrace) in a let block. 245 | ;; 246 | ;; The second frame, ’let’, is mysteriously absent when this 247 | ;; package is byte-compiled. 248 | (skip-frames (if (eq 'let* (backtrace-frame-fun (nth 1 frames))) 249 | 4 250 | 3))) 251 | (dotimes (idx (length frames)) 252 | (if (> idx skip-frames) 253 | (let* ((frame (nth idx frames)) 254 | (fun (backtrace-frame-fun frame)) 255 | ;; if function is a lambda, just send back the 256 | ;; 'lambda symbol instead of the entire function 257 | ;; definition. likewise for closures, which are what 258 | ;; lambdas become when lexical-binding is t. 259 | ;; 260 | ;; compiled functions are returned as 261 | ;; 'compiled-function, as they do not contain their 262 | ;; own names. 263 | (clean-fun (cond 264 | ((and (listp fun) 265 | (eq (car fun) 'lambda)) 266 | 'lambda) 267 | ((and (listp fun) 268 | (eq (car fun) 'closure)) 269 | 'lambda) 270 | ((macrop fun) 'macro) 271 | ((byte-code-function-p fun) 272 | 'compiled-function) 273 | (t fun))) 274 | (path (snitch--find-function-file fun)) 275 | (package (if path (snitch--package-from-path path) nil))) 276 | ;; if function is the timer handler, save its timer object 277 | ;; to lookup the backtrace for that timer later 278 | (if (eq fun #'timer-event-handler) 279 | (setq timer-args (car (backtrace-frame-args frame)))) 280 | ;;(message "frame %d: %s (%s) [%s]" idx fun path package) 281 | (push (list clean-fun path package) stack)))) 282 | (if follow-timer 283 | (snitch--maybe-add-timer-backtrace stack timer-args) 284 | (nreverse stack)))) 285 | 286 | (defun snitch--package-type-more-important (a b) 287 | "Determine if A is a more important package than B. 288 | 289 | Return t if package type of 'a' is more important than the 290 | package type of b, where: 291 | 292 | - nil > nil 293 | - built-in > nil, built-in 294 | - site-lisp > nil, built-in, site-lisp 295 | - user > nil, built-in, site-lisp 296 | - package > nil, built-in, site-lisp, user 297 | 298 | Noting that the first three are more important than themselves. 299 | This is due to long chains of nil/built-in/site-lisp packages in 300 | every backtrace, where typically the earliest one is the one that 301 | started the chain. 302 | 303 | On the other hand, for packages, we really want to focus on the 304 | very last function that was responsible for triggering the rest 305 | of the Emacs internal activity." 306 | (cond 307 | ;; nil only greater than nil 308 | ((null a) (member b (list nil))) 309 | ;; built-in more important than nil, and itself 310 | ((eq 'built-in a) (member b (list nil 'built-in))) 311 | ;; site-lisp more important than nil, built-in, and itself 312 | ((eq 'site-lisp a) (member b (list nil 'built-in 'site-lisp))) 313 | ;; user more important than earlier, but not more important 314 | ;; than itself. 315 | ((eq 'user a) (member b (list nil 'site-lisp 'built-in))) 316 | ;; installed package is most important, traversal stops here. 317 | ((symbolp a) (member b (list nil 'site-lisp 'built-in 'user))) 318 | ;; anything else is unknown 319 | (t nil))) 320 | 321 | 322 | (defun snitch--responsible-caller (backtrace) 323 | "Determine entry in backtrace responsible for the event. 324 | 325 | Return a single entry from BACKTRACE which is snitch’s best guess 326 | for which function on the stack frame should be considered 327 | ’responsible’ for causing this event. snitch uses this to assign 328 | one single function/file/package as the responsible party for an 329 | event, for use in filtering. 330 | 331 | This is inherently fallible, based on prioritizing certain 332 | function types and locations over others with some very primitive 333 | heuristics. It is, however, deterministic." 334 | (cl-loop for caller in backtrace with result = nil 335 | when (and (snitch--package-type-more-important 336 | (nth 2 caller) 337 | (if (null result) nil 338 | (nth 2 (car result)))) 339 | ;; as a special case, ignore functions in 340 | ;; startup.el since it doesn't really make sense 341 | ;; for them to be the resposible caller 342 | (not (and (eq (nth 2 caller) 'site-lisp) 343 | (string-suffix-p "/startup.el" (nth 1 caller))))) 344 | do 345 | (push caller result) 346 | finally return (car result))) 347 | 348 | (provide 'snitch-backtrace) 349 | 350 | ;;; snitch-backtrace.el ends here 351 | -------------------------------------------------------------------------------- /snitch-custom.el: -------------------------------------------------------------------------------- 1 | ;;; snitch-custom.el --- -*- lexical-binding: t; -*- 2 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3 | ;; 4 | ;; See snitch.el for full details. 5 | ;; 6 | ;; Copyright (C) 2020 Trevor Bentley 7 | ;; Author: Trevor Bentley 8 | ;; URL: https://github.com/mrmekon/snitch-el 9 | ;; 10 | ;; This file is not part of GNU Emacs. 11 | ;; 12 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13 | ;; 14 | ;;; Commentary: 15 | ;; 16 | ;; This file provides the customizable user options for snitch.el. 17 | ;; 18 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 19 | ;; 20 | ;; This program is free software; you can redistribute it and/or modify 21 | ;; it under the terms of the GNU General Public License as published by 22 | ;; the Free Software Foundation; either version 2, or (at your option) 23 | ;; any later version. 24 | ;; 25 | ;; This program is distributed in the hope that it will be useful, 26 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 27 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 28 | ;; GNU General Public License for more details. 29 | ;; 30 | ;; You should have received a copy of the GNU General Public License 31 | ;; along with this program; see the file COPYING. If not, write to 32 | ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth 33 | ;; Floor, Boston, MA 02110-1301, USA. 34 | ;; 35 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 36 | ;; 37 | ;;; Code: 38 | 39 | (eieio-declare-slots 40 | src-fn src-path src-pkg proc-name 41 | host port family 42 | executable args) 43 | 44 | ;; 45 | ;; 46 | ;; Customizable variables 47 | ;; 48 | ;; 49 | 50 | ;;;###autoload 51 | (defgroup snitch nil 52 | "Customization options for the snitch firewall" 53 | :group 'communication 54 | :prefix "snitch-") 55 | 56 | ;;;###autoload 57 | (defcustom snitch-lighter nil 58 | "Text to display for snitch in mode-line. 59 | 60 | Text to display in mode-line when snitch is enabled, or nil to 61 | hide." 62 | :type 'string 63 | :group 'snitch) 64 | 65 | 66 | ;;;###autoload 67 | (defgroup snitch-log nil 68 | "Logging options for snitch firewall" 69 | :group 'snitch 70 | :prefix "snitch-") 71 | 72 | ;;;###autoload 73 | (defcustom snitch-log-policy '(all) 74 | "Logging policies for snitch. 75 | 76 | Specifies types of actions that snitch should log. Provided as a 77 | list of symbols defined in ‘snitch-log-policies’" 78 | :type '(repeat (choice (const all) 79 | (const blocked) 80 | (const allowed) 81 | (const whitelisted) 82 | (const blacklisted))) 83 | :group 'snitch-log) 84 | 85 | ;;;###autoload 86 | (defcustom snitch-log-verbose nil 87 | "Enable verbose logging for snitch. 88 | 89 | Whether the log output should be extra verbose (pretty-printed 90 | multi-line event logs)." 91 | :type 'boolean 92 | :group 'snitch-log) 93 | 94 | ;;;###autoload 95 | (defcustom snitch-log-buffer-max-lines 1000 96 | "Max lines in snitch log buffer. 97 | 98 | Maximum number of lines to keep in the snitch event log 99 | buffer. When it grows larger than this, the least recent lines 100 | are periodically truncated by a timer. 101 | 102 | Since trimming is timer-based, the log buffer can temporarily 103 | grow larger than the requested value. It is only trimmed after a 104 | period of Emacs idle time. 105 | 106 | Set to 0 for unlimited." 107 | :type 'number 108 | :group 'snitch-log) 109 | 110 | ;;;###autoload 111 | (defcustom snitch-enable-notifications nil 112 | "Enable pop-up notifications for snitch events. 113 | 114 | Whether snitch should raise notifications for each log 115 | message, in addition to printing them in the log buffer. 116 | 117 | This feature requires the ‘alert’ package to be available. 118 | 119 | Users can define custom styles for alert with 120 | ‘alert-define-style’. All snitch alerts set ‘category’ to 121 | ‘snitch’, provide an ‘id’ field unique to each event, and provide 122 | the event object in ‘data’." 123 | :type 'boolean 124 | :group 'snitch-log) 125 | 126 | 127 | ;;;###autoload 128 | (defgroup snitch-policy nil 129 | "Default firewall policy options for snitch" 130 | :group 'snitch 131 | :prefix "snitch-") 132 | 133 | ;;;###autoload 134 | (defcustom snitch-process-policy 'allow 135 | "Default firewall policy for subprocesses. 136 | 137 | When set to allow, exceptions can be specified in 138 | ‘snitch-process-blacklist’. When set to deny, exceptions can be 139 | specified in ‘snitch-process-whitelist’." 140 | :type '(choice (const deny) 141 | (const allow)) 142 | :group 'snitch-policy) 143 | 144 | ;;;###autoload 145 | (defcustom snitch-network-policy 'allow 146 | "Default firewall policy for network connections. 147 | 148 | When set to allow, exceptions can be specified in 149 | ‘snitch-network-blacklist’. When set to deny, exceptions can be 150 | specified in ‘snitch-network-whitelist’." 151 | :type '(choice (const deny) 152 | (const allow)) 153 | :group 'snitch-policy) 154 | 155 | 156 | ;;;###autoload 157 | (defgroup snitch-rules nil 158 | "Firewall rules for snitch (blacklists/whitelists)" 159 | :group 'snitch 160 | :prefix "snitch-") 161 | 162 | ;;;###autoload 163 | (defcustom snitch-network-blacklist 164 | '() 165 | "List of forbidden network connections. 166 | 167 | A list of rules defining which network connections are forbidden 168 | when snitch.el is configured to allow connections by default. 169 | 170 | See documentation of ‘snitch-process-whitelist’ for details." 171 | :group 'snitch-rules 172 | :type '(alist :key-type function 173 | :value-type (repeat sexp))) 174 | 175 | ;;;###autoload 176 | (defcustom snitch-network-whitelist 177 | '() 178 | "List of permitted network connections. 179 | 180 | A list of rules defining which network connections are permitted 181 | when snitch.el is configured to deny connections by default. 182 | 183 | See documentation of ‘snitch-process-whitelist’ for details." 184 | :group 'snitch-rules 185 | :type '(alist :key-type function 186 | :value-type (repeat sexp))) 187 | 188 | ;;;###autoload 189 | (defcustom snitch-process-blacklist 190 | '( 191 | ;; Example: block processes from elfeed 192 | ;;(snitch-filter/src-pkg . (elfeed)) 193 | 194 | ;; Example: block processes from system packages 195 | ;;(snitch-filter/src-pkg . (site-lisp)) 196 | 197 | ;; Example: block processes from Emacs built-ins 198 | ;;(snitch-filter/src-pkg . (built-in)) 199 | 200 | ;; Example: block processes from an unknown user package 201 | ;;(snitch-filter/src-pkg . (user)) 202 | ) 203 | "List of forbidden subprocesses. 204 | 205 | A list of rules defining which subprocess calls are forbidden 206 | when snitch.el is configured to allow subprocesses by default. 207 | 208 | See documentation of ‘snitch-process-whitelist’ for details." 209 | :group 'snitch-rules 210 | :type '(alist :key-type function 211 | :value-type (repeat sexp))) 212 | 213 | ;;;###autoload 214 | (defcustom snitch-process-whitelist 215 | '() 216 | "List of permitted subprocesses. 217 | 218 | A list of rules defining which subprocess calls are permitted 219 | when snitch.el is configured to deny subprocesses by default. 220 | 221 | If any filter returns true, the process is immediately allowed 222 | without checking any remaining rules. 223 | 224 | Format is an alist of filter function and argument lists, in the 225 | form: 226 | 227 | '((filter-fn1 . (arg1)) 228 | (filter-fn2 . (arg2 arg3)) 229 | (filter-fn3 . (arg4 arg5 arg6))) 230 | 231 | Each filter function must take a ‘snitch-network-entry’ eieio 232 | object as its first parameter, and any number of subsequent 233 | arguments which are specified as the arguments in this alist. 234 | 235 | In the above example, filter-fn2 might be defined: 236 | 237 | (defun filter-fn2 (net-event fn-arg pkg-arg) 238 | (or (string-equal (oref net-event :src-fn) fn-arg) 239 | (string-equal (oref net-event :src-pkg) pkg-arg))) 240 | 241 | This allows any arbitrary filtering rules, at the expense of 242 | efficiency. Keep short-circuiting in mind, and put more general 243 | rules earlier in the list." 244 | :group 'snitch-rules 245 | :type '(alist :key-type function 246 | :value-type (repeat sexp))) 247 | 248 | 249 | ;; 250 | ;; 251 | ;; Hooks 252 | ;; 253 | ;; 254 | 255 | ;;;###autoload 256 | (defgroup snitch-hooks nil 257 | "Hooks (callbacks) for snitch firewall events." 258 | :group 'snitch 259 | :prefix "snitch-") 260 | 261 | ;;;###autoload 262 | (defcustom snitch-on-event-functions '() 263 | "Hooks called for every event that snitch can intercept. 264 | 265 | Note that every event that is not blocked by these hooks is sent 266 | twice: once to these hooks on initial reception, and again to one 267 | of the other hooks with snitch's final decision. 268 | 269 | Callback functions must take two arguments: 270 | 271 | 1) a ‘snitch-actions’ symbol describing the event type (‘event’) 272 | 273 | 2) an event object, either a ‘snitch-process-entry’ or 274 | ‘snitch-network-entry’. 275 | 276 | Returning nil blocks the event, terminating processing." 277 | :group 'snitch-hooks 278 | :type 'hook) 279 | 280 | ;;;###autoload 281 | (defcustom snitch-on-block-functions '() 282 | "Hooks called for events that are about to be blocked by policy. 283 | 284 | Callback functions must take two arguments: 285 | 286 | 1) a ‘snitch-actions’ symbol describing the event type (‘block’) 287 | 288 | 2) an event object, either a ‘snitch-process-entry’ or 289 | ‘snitch-network-entry’. 290 | 291 | Returning nil interrupts the block, allowing the event to pass." 292 | :group 'snitch-hooks 293 | :type 'hook) 294 | 295 | ;;;###autoload 296 | (defcustom snitch-on-allow-functions '() 297 | "Hooks called for events that are about to be allowed by policy. 298 | 299 | Callback functions must take two arguments: 300 | 301 | 1) a ‘snitch-actions’ symbol describing the event type (‘allow’) 302 | 303 | 2) an event object, either a ‘snitch-process-entry’ or 304 | ‘snitch-network-entry’. 305 | 306 | Returning nil blocks the event, terminating processing." 307 | :group 'snitch-hooks 308 | :type 'hook) 309 | 310 | ;;;###autoload 311 | (defcustom snitch-on-whitelist-functions '() 312 | "Hooks called for events that are about to be allowed by whitelist. 313 | 314 | Callback functions must take two arguments: 315 | 316 | 1) a ‘snitch-actions’ symbol describing the event type (‘whitelist’) 317 | 318 | 2) an event object, either a ‘snitch-process-entry’ or 319 | ‘snitch-network-entry’. 320 | 321 | Returning nil blocks the event, terminating processing." 322 | :group 'snitch-hooks 323 | :type 'hook) 324 | 325 | ;;;###autoload 326 | (defcustom snitch-on-blacklist-functions '() 327 | "Hooks called for events that are about to be blocked by blacklist. 328 | 329 | Callback functions must take two arguments: 330 | 331 | 1) a ‘snitch-actions’ symbol describing the event type (‘blacklist’) 332 | 333 | 2) an event object, either a ‘snitch-process-entry’ or 334 | ‘snitch-network-entry’. 335 | 336 | Returning nil interrupts the block, allowing the event to pass." 337 | :group 'snitch-hooks 338 | :type 'hook) 339 | 340 | ;;;###autoload 341 | (defcustom snitch-log-filter-window-open-hook '() 342 | "Called immediately after log filter window opens." 343 | :group 'snitch-hooks 344 | :type 'hook) 345 | 346 | ;;;###autoload 347 | (defcustom snitch-log-filter-window-close-hook '() 348 | "Called immediately after log filter window closes." 349 | :group 'snitch-hooks 350 | :type 'hook) 351 | 352 | ;;;###autoload 353 | (defcustom snitch-init-hook '() 354 | "Called immediately after snitch initializes." 355 | :group 'snitch-hooks 356 | :type 'hook) 357 | 358 | ;;;###autoload 359 | (defcustom snitch-deinit-hook '() 360 | "Called immediately after snitch deinitializes." 361 | :group 'snitch-hooks 362 | :type 'hook) 363 | 364 | ;;;###autoload 365 | (defcustom snitch-log-functions '() 366 | "Hooks called for snitch log entries. 367 | 368 | These hooks can be used to filter snitch's log output. One 369 | possible use is removing potentially sensitive information from 370 | the log, such as authentication tokens passed to curl as 371 | arguments. 372 | 373 | Callback functions must take one argument: a log message string, 374 | propertized with details about the event that generated it. 375 | 376 | Return t to keep the log unchanged, nil to block the log entry, 377 | or a new propertized string to replace the log line. 378 | 379 | If several hooks are registered, the first hook to return nil or 380 | a modified string terminates processing. 381 | 382 | Hooks that modify the message are strongly encouraged to keep the 383 | timestamp and trailing newline intact." 384 | :group 'snitch-hooks 385 | :type 'hook) 386 | 387 | 388 | ;; 389 | ;; 390 | ;; Fonts 391 | ;; 392 | ;; 393 | 394 | ;;;###autoload 395 | (defgroup snitch-faces nil 396 | "Faces for snitch firewall windows" 397 | :group 'snitch 398 | :prefix "snitch-") 399 | 400 | ;;;###autoload 401 | (defface snitch--log-filter-face 402 | '((t . (:inherit default))) 403 | "Face for log filter wizard" 404 | :group 'snitch-faces) 405 | 406 | ;;;###autoload 407 | (defface snitch--log-filter-active-face 408 | '((t . (:inherit snitch--log-filter-face :inverse-video t :weight bold))) 409 | "Face for log filter wizard, selected entries" 410 | :group 'snitch-faces) 411 | 412 | 413 | ;; 414 | ;; 415 | ;; Key mappings 416 | ;; 417 | ;; 418 | 419 | (declare-function snitch-log-filter-finish "snitch-log.el") 420 | (declare-function snitch-log-filter-cancel "snitch-log.el") 421 | 422 | ;;;###autoload 423 | (defvar snitch-log-filter-map 424 | (let ((map (make-sparse-keymap))) 425 | (define-key map "\C-c\C-c" #'snitch-log-filter-finish) 426 | (define-key map "\C-g" #'snitch-log-filter-cancel) 427 | (define-key map "\C-c\C-k" #'snitch-log-filter-cancel) 428 | map) 429 | "Keymap for the snitch log filter wizard. 430 | 431 | Override the default entries to change the key combinations that 432 | save or cancel the selection.") 433 | 434 | 435 | ;; 436 | ;; 437 | ;; Timers 438 | ;; 439 | ;; 440 | 441 | ;;;###autoload 442 | (defgroup snitch-timer nil 443 | "Options related to when and how snitch monitors timers." 444 | :group 'snitch-timer 445 | :prefix "snitch-") 446 | 447 | ;;;###autoload 448 | (defcustom snitch-trace-timers t 449 | "Enable tracing event sources through Emacs timers. 450 | 451 | Whether to decorate timer callbacks with backtraces, so snitch 452 | can identify the package source of an event that was scheduled on 453 | a timer. 454 | 455 | This must be configured before initializing snitch with function 456 | ‘snitch-mode’. If it is changed while snitch is running, call 457 | ‘snitch-restart’. 458 | 459 | Enabling this requires snitch to intercept all Emacs timers. 460 | This can cause significant delays if there are very many timers, 461 | or very high-speed timers. Use ‘snitch-timer-blacklist’ to 462 | exclude specific timers from snitch’s tracking. 463 | 464 | You can run ‘snitch-monitor-unique-timer-fns’ to find out if any 465 | timers are running often. See `snitch-monitor-unique-timer-fns’ 466 | for more." 467 | :type 'boolean 468 | :group 'snitch-timer) 469 | 470 | ;; TODO: hook this up, and consider a whitelist too 471 | ;;;;;###autoload 472 | ;;(defcustom snitch-timer-blacklist 473 | ;; '( 474 | ;; #'isearch-lazy-highlight-start 475 | ;; #'undo-auto--boundary-timer 476 | ;; #'helm-M-x--notify-prefix-arg 477 | ;; #'helm-ff--cache-mode-refresh 478 | ;; #'helm-match-line-cleanup 479 | ;; #'company-idle-begin 480 | ;; ) 481 | ;; "List of timer functions to skip decorating with backtraces 482 | ;;when ‘snitch-trace-timers’ is t. Backtrace decoration takes 483 | ;;time, and may cause noticeable delays if coupled with high-speed 484 | ;;timers. 485 | ;; 486 | ;;Functions can be specified as symbols, or, for byte-compiled 487 | ;;functions and lambdas, as the SHA1 hash digest of the byte code 488 | ;;or lambda expression in hex string format. 489 | ;; 490 | ;;You can run ‘snitch-monitor-unique-timer-fns’ to find out if any 491 | ;;timers are running often. See `snitch-monitor-unique-timer-fns' for 492 | ;;more. This function also displays the SHA1 hash of unnamed 493 | ;;functions." :type '(repeat (choice (function) (string))) :group 494 | ;;'snitch-timer) 495 | 496 | ;;;###autoload 497 | (defcustom snitch-print-timer-warnings t 498 | "Print warnings related to snitch timer tracing. 499 | 500 | Whether snitch should output warnings when the functions tracking 501 | timer backtraces encounter an unusual situation, such as a 502 | missing timer or a timer that never fires. 503 | 504 | Note that misbehaved packages that cancel timers that aren't 505 | scheduled will trigger false-positive warnings." 506 | :type 'boolean 507 | :group 'snitch-timer) 508 | 509 | 510 | (provide 'snitch-custom) 511 | 512 | ;;; snitch-custom.el ends here 513 | -------------------------------------------------------------------------------- /snitch-filter.el: -------------------------------------------------------------------------------- 1 | ;;; snitch-filter.el --- -*- lexical-binding: t; -*- 2 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3 | ;; 4 | ;; See snitch.el for full details. 5 | ;; 6 | ;; Copyright (C) 2020 Trevor Bentley 7 | ;; Author: Trevor Bentley 8 | ;; URL: https://github.com/mrmekon/snitch-el 9 | ;; 10 | ;; This file is not part of GNU Emacs. 11 | ;; 12 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13 | ;; 14 | ;;; Commentary: 15 | ;; 16 | ;; This file provides some filter functions for snitch.el. 17 | ;; 18 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 19 | ;; 20 | ;; This program is free software; you can redistribute it and/or modify 21 | ;; it under the terms of the GNU General Public License as published by 22 | ;; the Free Software Foundation; either version 2, or (at your option) 23 | ;; any later version. 24 | ;; 25 | ;; This program is distributed in the hope that it will be useful, 26 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 27 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 28 | ;; GNU General Public License for more details. 29 | ;; 30 | ;; You should have received a copy of the GNU General Public License 31 | ;; along with this program; see the file COPYING. If not, write to 32 | ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth 33 | ;; Floor, Boston, MA 02110-1301, USA. 34 | ;; 35 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 36 | ;; 37 | ;;; Code: 38 | 39 | (eieio-declare-slots 40 | src-fn src-path src-pkg proc-name 41 | host port family 42 | executable args) 43 | 44 | ;; 45 | ;; 46 | ;; Filter functions 47 | ;; 48 | ;; 49 | 50 | (defun snitch-filter-name (event name) 51 | "Filter function for snitch rules. 52 | 53 | Takes the event object EVENT and process name as a string in 54 | NAME. Applies to both network and subprocess events." 55 | (string-equal (oref event proc-name) name)) 56 | 57 | (defun snitch-filter-src-pkg (event pkg) 58 | "Filter function for snitch rules. 59 | 60 | Takes the event object EVENT, and Emacs package that originated 61 | the event, PKG, as a symbol. Applies to both network and 62 | subprocess events." 63 | (eq (oref event src-pkg) pkg)) 64 | 65 | (defun snitch-filter-log (event &rest alist) 66 | "Filter function for snitch rules. 67 | 68 | Takes the event object EVENT, and ALIST, an alist generated by 69 | the snitch log filter wizard, filtering on all specified fields." 70 | (cl-loop for (aslot . avalue) in alist 71 | with accept = t 72 | do 73 | (let ((evalue (eieio-oref event aslot)) 74 | (val-type (type-of avalue))) 75 | (unless (cond 76 | ((eq val-type 'string) (string-equal avalue evalue)) 77 | (t (eq avalue evalue))) 78 | (setq accept nil))) 79 | ;; short-circuit, stop checking after first failure 80 | when (null accept) 81 | return nil 82 | finally return accept)) 83 | 84 | (provide 'snitch-filter) 85 | 86 | ;;; snitch-filter.el ends here 87 | -------------------------------------------------------------------------------- /snitch-log.el: -------------------------------------------------------------------------------- 1 | ;;; snitch-log.el --- -*- lexical-binding: t; -*- 2 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3 | ;; 4 | ;; See snitch.el for full details. 5 | ;; 6 | ;; Copyright (C) 2020 Trevor Bentley 7 | ;; Author: Trevor Bentley 8 | ;; URL: https://github.com/mrmekon/snitch-el 9 | ;; 10 | ;; This file is not part of GNU Emacs. 11 | ;; 12 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13 | ;; 14 | ;;; Commentary: 15 | ;; 16 | ;; This file provides logging, notification, and log-to-filter 17 | ;; functionality for snitch.el. 18 | ;; 19 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 20 | ;; 21 | ;; This program is free software; you can redistribute it and/or modify 22 | ;; it under the terms of the GNU General Public License as published by 23 | ;; the Free Software Foundation; either version 2, or (at your option) 24 | ;; any later version. 25 | ;; 26 | ;; This program is distributed in the hope that it will be useful, 27 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 28 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 29 | ;; GNU General Public License for more details. 30 | ;; 31 | ;; You should have received a copy of the GNU General Public License 32 | ;; along with this program; see the file COPYING. If not, write to 33 | ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth 34 | ;; Floor, Boston, MA 02110-1301, USA. 35 | ;; 36 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 37 | ;; 38 | ;;; Code: 39 | (require 'snitch-custom) 40 | (require 'snitch-filter) 41 | 42 | (declare-function alert "ext:alert") 43 | (declare-function snitch-process-entry "snitch.el") 44 | (declare-function snitch-process-entry-p "snitch.el") 45 | (declare-function snitch-network-entry "snitch.el") 46 | (declare-function snitch-network-entry-p "snitch.el") 47 | (eieio-declare-slots 48 | src-fn src-path src-pkg proc-name 49 | host port family 50 | executable args) 51 | 52 | ;; optional dependency on alert package 53 | (defvar snitch--have-alert (require 'alert nil t)) 54 | 55 | (defvar snitch--log-buffer-name "*snitch firewall log*" 56 | "Name of the buffer for the snitch firewall log.") 57 | (defvar snitch--log-filter-buffer-name "*snitch filter wizard*" 58 | "Name of the buffer for the log filter 'wizard' popup window.") 59 | 60 | (defvar snitch--log-filter-buffer nil 61 | "Buffer in the log filter 'wizard' popup window.") 62 | 63 | (defvar snitch--log-prune-timer nil 64 | "Timer to prune snitch log. 65 | 66 | Periodic timer to prune snitch log buffer to its maximum 67 | permitted size.") 68 | 69 | (defun snitch--exact-log-match (policies) 70 | "Check if log policies are explicitly enabled. 71 | 72 | Return true if any of POLICIES are explicitly defined in 73 | ‘snitch-log-policy’." 74 | (seq-some 'identity 75 | (mapcar (lambda (l) (member l snitch-log-policy)) 76 | policies))) 77 | 78 | (defun snitch--log-policy-match (policies) 79 | "Check of current log policies match given policies. 80 | 81 | Return true of any of the log policies in POLICIES are covered by 82 | one of the currently enabled policies in ‘snitch-log-policy’. 83 | 84 | This does not require exact matches. For instance, if POLICIES 85 | contains ‘process-whitelisted’ and ‘snitch-log-policy’ contains 86 | ‘whitelisted’, this function returns true, as ‘whitelisted’ is a 87 | larger set including both ‘process-whitelisted’ and 88 | ‘network-whitelisted’." 89 | (cond 90 | ;; all in policy, everything true 91 | ((member 'all snitch-log-policy) t) 92 | ;; exact match between requested and configured policies 93 | ((snitch--exact-log-match policies) t) 94 | ;; generalize whitelist policies 95 | ((and (or (member 'process-whitelisted policies) 96 | (member 'network-whitelisted policies)) 97 | (member 'whitelisted snitch-log-policy)) t) 98 | ;; generalize blacklist policies 99 | ((and (or (member 'process-blacklisted policies) 100 | (member 'network-blacklisted policies)) 101 | (member 'blacklisted snitch-log-policy)) t) 102 | ;; generalize allowed policies 103 | ((and (or (member 'process-allowed policies) 104 | (member 'network-allowed policies)) 105 | (member 'allowed snitch-log-policy)) t) 106 | ;; generalize blocked policies 107 | ((and (or (member 'process-blocked policies) 108 | (member 'network-blocked policies)) 109 | (member 'blocked snitch-log-policy)) t))) 110 | 111 | (defun snitch--pretty-obj-string (event) 112 | "Pretty-print a snitch event. 113 | 114 | Take an event eieio object, EVENT, and return it as a 115 | 'pretty-printed' string." 116 | ;; write eieio object out as a pretty string by redirecting 117 | ;; standard output stream to a function that consumes the output 118 | ;; char by char. This must be reversed and concatenated to 119 | ;; produce the final string. 120 | (let ((pretty-obj nil) 121 | (old-std standard-output)) 122 | (setq standard-output (lambda (c) (setq pretty-obj (cons c pretty-obj)))) 123 | (object-write event) 124 | (setq pretty-obj (concat (nreverse pretty-obj))) 125 | (setq standard-output old-std) 126 | pretty-obj)) 127 | 128 | (defun snitch--propertize (logmsg event) 129 | "Add snitch event as properties to log message. 130 | 131 | Add text properties to LOGMSG with elements from EVENT. This 132 | allows the log filter commands to re-assemble an event from its 133 | log message." 134 | (cond 135 | ;; process events 136 | ((snitch-process-entry-p event) 137 | (propertize logmsg 138 | 'snitch-class 'snitch-process-entry 139 | 'snitch-src-fn (oref event src-fn) 140 | 'snitch-src-path (oref event src-path) 141 | 'snitch-src-pkg (oref event src-pkg) 142 | 'snitch-proc-name (oref event proc-name) 143 | 'snitch-executable (oref event executable) 144 | 'snitch-args (oref event args))) 145 | ;; network events 146 | ((snitch-network-entry-p event) 147 | (propertize logmsg 148 | 'snitch-class 'snitch-network-entry 149 | 'snitch-src-fn (oref event src-fn) 150 | 'snitch-src-path (oref event src-path) 151 | 'snitch-src-pkg (oref event src-pkg) 152 | 'snitch-proc-name (oref event proc-name) 153 | 'snitch-host (oref event host) 154 | 'snitch-port (oref event port) 155 | 'snitch-family (oref event family))))) 156 | 157 | (defun snitch--run-filter-log-hooks (logmsg) 158 | "Run hooks to filter snitch log messages. 159 | 160 | Run all hooks registered in ‘snitch-log-functions’ with the given 161 | log message, LOGMSG. Return the original log message if all 162 | hooks return t (or none are defined), or return nil or a modified 163 | new log string based on the first hook to return something other 164 | than t." 165 | (if (null snitch-log-functions) 166 | logmsg 167 | (cl-loop for fn in snitch-log-functions with res = nil 168 | do (setq res (funcall fn logmsg)) 169 | when (or (null res) 170 | (stringp res)) 171 | return res 172 | finally return logmsg))) 173 | 174 | (defun snitch--log (evt-type event) 175 | "Log a snitch event. 176 | 177 | Log a snitch event to the dedicated snitch firewall log buffer. 178 | EVENT is an event object, and EVT-TYPE is any policy type from 179 | ‘snitch-log-policies’." 180 | (when (snitch--log-policy-match (list evt-type)) 181 | (let* ((name (cond ((eq evt-type 'all) "event") 182 | ((eq evt-type 'whitelisted) "whitelisted") 183 | ((eq evt-type 'process-whitelisted) "whitelisted") 184 | ((eq evt-type 'network-whitelisted) "whitelisted") 185 | ((eq evt-type 'blacklisted) "blacklisted") 186 | ((eq evt-type 'process-blacklisted) "blacklisted") 187 | ((eq evt-type 'network-blacklisted) "blacklisted") 188 | ((eq evt-type 'allowed) "allowed") 189 | ((eq evt-type 'process-allowed) "allowed") 190 | ((eq evt-type 'network-allowed) "allowed") 191 | ((eq evt-type 'blocked) "blocked") 192 | ((eq evt-type 'process-blocked) "blocked") 193 | ((eq evt-type 'network-blocked) "blocked") 194 | (t "other"))) 195 | (buf (get-buffer-create snitch--log-buffer-name)) 196 | (pretty-obj (snitch--pretty-obj-string event)) 197 | (timestamp (format-time-string "%Y-%m-%d %H:%M:%S")) 198 | (rawmsg (snitch--propertize 199 | (cond (snitch-log-verbose (format "[%s] (%s) --\n%s" 200 | timestamp name pretty-obj)) 201 | (t (format "[%s] (%s) -- %s\n" 202 | timestamp name event))) 203 | event)) 204 | (logmsg (snitch--run-filter-log-hooks rawmsg))) 205 | ;; start timer to keep log size limited 206 | (snitch--maybe-start-log-prune-timer) 207 | ;; write the formatted log entry to the log buffer 208 | (when logmsg 209 | (with-current-buffer buf 210 | (setq buffer-read-only nil) 211 | (buffer-disable-undo) 212 | (save-excursion 213 | (goto-char (point-max)) 214 | (insert logmsg)) 215 | (setq buffer-read-only t) 216 | ;; scroll log window to end if it is not active. Don’t 217 | ;; scroll when active to allow user to move around 218 | ;; uninterrupted in the log. 219 | (let ((log-win (get-buffer-window buf))) 220 | (when log-win 221 | (unless (eq (selected-window) log-win) 222 | (with-selected-window log-win 223 | (goto-char (point-max)))))))) 224 | ;; if the alert package is available and notifications are 225 | ;; enabled, also raise a notification 226 | (when (and logmsg snitch--have-alert snitch-enable-notifications) 227 | (alert logmsg 228 | :title (format "Snitch Event: %s" name) 229 | :severity 'normal 230 | :category 'snitch 231 | ;; :id allows alert to replace notifications with 232 | ;; updated ones. Since it is possible to get two 233 | ;; alerts for one object with snitch (if ’all logging 234 | ;; policy is enabled along with any other policy), we 235 | ;; pass the internal eieio object name, which is the 236 | ;; same if this event is raised again later 237 | :id (eieio-object-name-string event) 238 | ;; We also pass the raw event, so custom alert 239 | ;; handlers can parse it. There is no way to get 240 | ;; feedback from an alert, so this is only 241 | ;; informative. 242 | :data event))))) 243 | 244 | (defun snitch--prune-log-buffer () 245 | "Prune the snitch log buffer. 246 | 247 | Prune the size of log buffer to at most 248 | ‘snitch-log-buffer-max-lines’ lines long." 249 | ;; ensure timer is stopped. it will be started again by the next 250 | ;; log event. it’s wasteful to have a timer running when we know 251 | ;; the buffer isn’t growing. 252 | (snitch--stop-log-prune-timer) 253 | (let ((buf (get-buffer-create snitch--log-buffer-name))) 254 | (with-current-buffer buf 255 | (let ((line-count (count-lines (point-min) (point-max)))) 256 | (when (and (> snitch-log-buffer-max-lines 0) 257 | (> line-count snitch-log-buffer-max-lines)) 258 | (setq buffer-read-only nil) 259 | (buffer-disable-undo) 260 | (save-excursion 261 | (goto-char (point-min)) 262 | (forward-line (+ (- line-count snitch-log-buffer-max-lines) 1)) 263 | (delete-region (point-min) (point)) 264 | (goto-char (point-min)) 265 | (insert "[log trimmed]\n") 266 | (goto-char (point-max))) 267 | (setq buffer-read-only t)))))) 268 | 269 | (defun snitch--maybe-start-log-prune-timer () 270 | "Possibly start the snitch log pruning timer. 271 | 272 | Start the snitch log pruning timer if it is not already 273 | running." 274 | (unless snitch--log-prune-timer 275 | (snitch--start-log-prune-timer))) 276 | 277 | (defun snitch--start-log-prune-timer () 278 | "Start the snitch log pruning timer. 279 | 280 | Start the snitch log pruning timer. This is a non-repeating 281 | timer that calls ‘snitch--prune-log-buffer’ after a period of 282 | idle." 283 | (setq snitch--log-prune-timer 284 | (run-with-idle-timer 30 nil #'snitch--prune-log-buffer))) 285 | 286 | (defun snitch--stop-log-prune-timer () 287 | "Stop the snitch log pruning timer if it is running." 288 | (when snitch--log-prune-timer 289 | (cancel-timer snitch--log-prune-timer) 290 | (setq snitch--log-prune-timer nil))) 291 | 292 | 293 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 294 | ;; 295 | ;; 296 | ;; Log filter ’wizard’ 297 | ;; 298 | ;; 299 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 300 | 301 | ;;;###autoload 302 | (defun snitch-filter-from-log () 303 | "Open snitch ’log filter’ wizard on selected log entry. 304 | 305 | Opens an interactive 'wizard' to create a new snitch 306 | whitelist/blacklist rule based on the event log under the 307 | cursor. \\ 308 | 309 | To use the wizard, move the cursor over an item in the snitch 310 | firewall log buffer (default: ‘*snitch firewall log*’), and run 311 | this command (‘M-x snitch-filter-from-log’). A window will 312 | appear with contents populated from the selected log line. 313 | Typing the highlighted mnemonic characters toggles fields on and 314 | off. When all desired fields are selected, typing 315 | \\[snitch-log-filter-finish] appends the new filter to the 316 | existing blacklist or whitelist, and saves it persistently as a 317 | customized variable. Use \\[snitch-log-filter-cancel] to cancel 318 | without saving." 319 | (interactive) 320 | (let ((cls (get-text-property (point) 'snitch-class)) 321 | (fn (get-text-property (point) 'snitch-src-fn)) 322 | (path (get-text-property (point) 'snitch-src-path)) 323 | (pkg (get-text-property (point) 'snitch-src-pkg)) 324 | (name (get-text-property (point) 'snitch-proc-name))) 325 | (cond 326 | ((eq cls 'snitch-network-entry) 327 | (let ((host (get-text-property (point) 'snitch-host)) 328 | (port (get-text-property (point) 'snitch-port)) 329 | (family (get-text-property (point) 'snitch-family))) 330 | (snitch--run-log-filter-wizard (snitch-network-entry 331 | :src-fn fn 332 | :src-path path 333 | :src-pkg pkg 334 | :proc-name name 335 | :host host 336 | :port port 337 | :family family)))) 338 | ((eq cls 'snitch-process-entry) 339 | (let ((exec (get-text-property (point) 'snitch-executable)) 340 | (args (get-text-property (point) 'snitch-args))) 341 | (snitch--run-log-filter-wizard (snitch-process-entry 342 | :src-fn fn 343 | :src-path path 344 | :src-pkg pkg 345 | :proc-name name 346 | :executable exec 347 | :args args))))))) 348 | 349 | (defun snitch-log-filter-finish () 350 | "Dummy finish function for keymap entries. 351 | 352 | Map to key combo to save and finish a snitch log filter wizard 353 | selection." nil) 354 | 355 | (defun snitch-log-filter-cancel () 356 | "Dummy cancel function for keymap entries. 357 | 358 | Map to key combo to cancel a snitch log filter wizard selection 359 | without saving." nil) 360 | 361 | (defun snitch--run-log-filter-wizard (event) 362 | "Run user interface for ’log filter’ wizard. 363 | 364 | Runs the snitch log filter 'wizard', an interactive popup window 365 | to help a user create a new blacklist or whitelist filter based 366 | on a log entry which has been converted back into a snitch event, 367 | EVENT. This function sets up the window, populates it, loops 368 | over user keypresses, and eventually saves the filter to the 369 | customization variable if appropriate." 370 | ;; create buffer if needed 371 | (unless snitch--log-filter-buffer 372 | (snitch--init-log-filter-buffer)) 373 | ;; set initial contents of buffer so it opens to the correct size 374 | (snitch--redraw-log-filter-buffer event nil) 375 | ;; display window 376 | (snitch--show-log-filter-window) 377 | ;; read user input continuously until saved or aborted 378 | (let ((fields nil) 379 | (finished nil) 380 | (slot-value-alist nil) 381 | (black-white nil) 382 | (key-map (snitch--log-filter-map event))) 383 | (while (not finished) 384 | ;; redraw to update font properties 385 | (snitch--redraw-log-filter-buffer event fields) 386 | (let* ((key (read-key-sequence "Enter field: ")) 387 | (keyfn (lookup-key snitch-log-filter-map key))) 388 | (cond 389 | ;; ignore, probably a control character (arrow keys, etc) 390 | ;; must come first to short-circuit before string comparisons 391 | ((not (stringp key)) nil) 392 | ;; abort and exit 393 | ((equal keyfn #'snitch-log-filter-cancel) (setq fields '() finished t)) 394 | ;; save and exit 395 | ((equal keyfn #'snitch-log-filter-finish) (setq finished t)) 396 | ;; some other string. check if string is in field map, and 397 | ;; if so toggle that slot of the event in the list of slots 398 | ;; to filter on 399 | ((stringp key) 400 | (let ((slot (snitch--log-filter-map-slot-from-key key-map key))) 401 | (when slot 402 | (if (member slot fields) 403 | (setq fields (delete slot fields)) 404 | (setq fields (cons slot fields))))))))) 405 | ;; close filter window 406 | (snitch--hide-log-filter-window snitch--log-filter-buffer) 407 | ;; generate filter 408 | (when fields 409 | ;; make an alist of (slot . value) pairs for the filter function 410 | ;; to match against 411 | (cl-loop for slot in fields 412 | do 413 | (setq slot-value-alist 414 | (cons (cons slot (eieio-oref event slot)) slot-value-alist))) 415 | ;; query user for whether this should go in blacklist or whitelist 416 | (while (null black-white) 417 | (let* ((key (read-key-sequence "[b]lacklist or [w]hitelist? ")) 418 | (keyfn (lookup-key snitch-log-filter-map key))) 419 | (cond 420 | ;; ignore, probably a control character (arrow keys, etc) 421 | ;; must come first to short-circuit before string comparisons 422 | ((not (stringp key)) nil) 423 | ((equal keyfn #'snitch-log-filter-cancel) (setq fields '() black-white "blacklist")) 424 | ((string-equal key "b") (setq black-white "blacklist")) 425 | ((string-equal key "w") (setq black-white "whitelist"))))) 426 | ;; append the new entry to the correct defcustom list, and 427 | ;; save as default customization. 428 | (when fields 429 | (let* ((filter (cons #'snitch-filter-log slot-value-alist)) 430 | (orig-list (cond 431 | ((snitch-network-entry-p event) 432 | (intern-soft (format "snitch-network-%s" black-white))) 433 | ((snitch-process-entry-p event) 434 | (intern-soft (format "snitch-process-%s" black-white))) 435 | (t nil))) 436 | (orig-val (eval orig-list)) 437 | (new-list (cons filter orig-val))) 438 | (customize-save-variable orig-list new-list)))))) 439 | 440 | (defun snitch--log-filter-map-slot-from-key (map key) 441 | "Return field matching key press in snitch log filter. 442 | 443 | Given a map from ‘snitch--log-filter-map’, MAP, returns the slot 444 | matching to the given keypress, KEY, or nil." 445 | (cl-loop for (slot . plist) in map 446 | when (string-equal (plist-get plist 'key) key) 447 | return slot 448 | finally return nil)) 449 | 450 | (defun snitch--log-filter-map (event) 451 | "Return a mapping of event fields to names and keymaps. 452 | 453 | Returns an alist of (SLOT . PLIST) pairs, where each PLIST 454 | contains a field name, a key to press to select it, and a 455 | ‘mnemonic’ version of the name with the key highlighted in square 456 | brackets. The correct set of fields is returned based on the 457 | type of event in EVENT. All of this stuff is used to display the 458 | fields, and to interpret which field to select when receiving 459 | user keypresses." 460 | (let ((common-alist nil) 461 | (network-alist nil) 462 | (process-alist nil)) 463 | (setq common-alist 464 | '((src-fn . (key "f" name "function" 465 | mnemonic-name "[f]unction")) 466 | (src-path . (key "p" name "path" 467 | mnemonic-name "[p]ath")) 468 | (src-pkg . (key "k" name "package" 469 | mnemonic-name "pac[k]age")) 470 | (proc-name . (key "n" name "name" 471 | mnemonic-name "[n]ame")))) 472 | (setq network-alist 473 | '((host . (key "h" name "host" 474 | mnemonic-name "[h]ost")) 475 | (port . (key "o" name "port" 476 | mnemonic-name "p[o]rt")) 477 | (family . (key "m" name "family" 478 | mnemonic-name "fa[m]ily")))) 479 | (setq process-alist 480 | '((executable . (key "x"name "executable" 481 | mnemonic-name "e[x]ecutable")) 482 | (args . (key "g" name "args" 483 | mnemonic-name "ar[g]s")))) 484 | (cond 485 | ((snitch-network-entry-p event) (append common-alist network-alist)) 486 | ((snitch-process-entry-p event) (append common-alist process-alist)) 487 | (t common-alist)))) 488 | 489 | (defun snitch--redraw-log-filter-buffer (evt selected) 490 | "Draw contents of snitch log filter buffer. 491 | 492 | Draw the text contents of the log-filter menu based on the given 493 | event, EVT, and list of currently selected fields, SELECTED. 494 | Each field name is drawn on a separate line, along with its value 495 | in the current event. The ‘mnemonic’ version of the field name 496 | is displayed, with the character to press surrounded by square 497 | brackets. Fields that are currently selected display in a 498 | different font." 499 | (with-current-buffer snitch--log-filter-buffer 500 | (erase-buffer) 501 | (let ((evt-type (if (snitch-network-entry-p evt) 502 | "network" 503 | "process"))) 504 | (insert (format "Creating new snitch %s filter from template:\n" evt-type)) 505 | (cl-loop for (slot . plist) in (snitch--log-filter-map evt) 506 | do 507 | (let* ((msg (format "%-12s: %s" (plist-get plist 'mnemonic-name) 508 | (eieio-oref evt slot))) 509 | (styled-msg (propertize 510 | msg 'face 511 | (if (member slot selected) 512 | 'snitch--log-filter-active-face 513 | 'snitch--log-filter-face)))) 514 | (insert "\n") 515 | (insert styled-msg))) 516 | (insert "\n") 517 | (insert "\nSave: C-c C-c / Abort: C-c C-k") 518 | (goto-char (point-min))))) 519 | 520 | (defun snitch--init-log-filter-buffer () 521 | "Initialize log filter UI. 522 | 523 | Initialize buffer for displaying UI to generate a snitch filter 524 | from an existing log line." 525 | ;; logic looted from which-key 526 | (unless (buffer-live-p snitch--log-filter-buffer) 527 | (setq snitch--log-filter-buffer 528 | (get-buffer-create snitch--log-filter-buffer-name)) 529 | (with-current-buffer snitch--log-filter-buffer 530 | (let (message-log-max) 531 | (toggle-truncate-lines 1) 532 | (message "")) 533 | (setq-local cursor-type nil) 534 | (setq-local cursor-in-non-selected-windows nil) 535 | (setq-local mode-line-format nil) 536 | (setq-local word-wrap nil) 537 | (setq-local show-trailing-whitespace nil)))) 538 | 539 | (defun snitch--hide-log-filter-window (buffer) 540 | "Hide snitch log filter UI. 541 | 542 | Hide snitch log filter window, which is the window currently 543 | displaying BUFFER." 544 | ;; based on which-key 545 | (when (buffer-live-p buffer) 546 | (quit-windows-on buffer) 547 | (run-hooks 'snitch-log-filter-window-close-hook))) 548 | 549 | (defun snitch--log-filter-window-size-to-fit (window) 550 | "Resize snitch log filter window. 551 | 552 | Resize log filter window, WINDOW, to a reasonable height and 553 | maximum width." 554 | ;; based on which-key 555 | ;; cap at 30% of the vertical height 556 | (let ((fit-window-to-buffer-horizontally t) 557 | (window-min-height 5) 558 | (max-height (round (* .3 (window-total-height (frame-root-window)))))) 559 | (fit-window-to-buffer window max-height))) 560 | 561 | (defun snitch--show-log-filter-window () 562 | "Show snitch log filter window. 563 | 564 | Open or switch focus to the log filter window, resizing it as 565 | necessary." 566 | ;; based on which-key 567 | (let* ((alist 568 | `((window-width . snitch--log-filter-window-size-to-fit) 569 | (window-height . snitch--log-filter-window-size-to-fit) 570 | (side . bottom) 571 | (slot . 0)))) 572 | ;; Comment preserved from which-key: 573 | ;; Previously used `display-buffer-in-major-side-window' here, but 574 | ;; apparently that is meant to be an internal function. See emacs bug #24828 575 | ;; and advice given there. 576 | (cond 577 | ((get-buffer-window snitch--log-filter-buffer) 578 | (display-buffer-reuse-window snitch--log-filter-buffer alist)) 579 | (t 580 | (display-buffer-in-side-window snitch--log-filter-buffer alist))) 581 | (run-hooks 'snitch-log-filter-window-open-hook))) 582 | 583 | (provide 'snitch-log) 584 | 585 | ;;; snitch-log.el ends here 586 | -------------------------------------------------------------------------------- /snitch-test.el: -------------------------------------------------------------------------------- 1 | ;;; snitch-test.el --- -*- lexical-binding: t; -*- 2 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3 | ;; 4 | ;; See snitch.el for full details. 5 | ;; 6 | ;; Copyright (C) 2020 Trevor Bentley 7 | ;; Author: Trevor Bentley 8 | ;; URL: https://github.com/mrmekon/snitch-el 9 | ;; 10 | ;; This file is not part of GNU Emacs. 11 | ;; 12 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13 | ;; 14 | ;;; Commentary: 15 | ;; 16 | ;; This file provides manual and automated test routines for 17 | ;; validating the functionality of snitch.el. 18 | ;; 19 | ;; The automated tests are best run from the command line using 20 | ;; something like this: 21 | ;; 22 | ;; $ emacs -batch \ 23 | ;; --eval "(add-to-list 'load-path \"~/.emacs.d/snitch/\")" \ 24 | ;; --eval "(package-initialize)" \ 25 | ;; -l ert -l snitch-test.el \ 26 | ;; -f ert-run-tests-batch-and-exit 27 | ;; 28 | ;; Replace the path to snitch with your own, or leave it out if snitch 29 | ;; is already installed as a package. 30 | ;; 31 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 32 | ;; 33 | ;; This program is free software; you can redistribute it and/or modify 34 | ;; it under the terms of the GNU General Public License as published by 35 | ;; the Free Software Foundation; either version 2, or (at your option) 36 | ;; any later version. 37 | ;; 38 | ;; This program is distributed in the hope that it will be useful, 39 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 40 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 41 | ;; GNU General Public License for more details. 42 | ;; 43 | ;; You should have received a copy of the GNU General Public License 44 | ;; along with this program; see the file COPYING. If not, write to 45 | ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth 46 | ;; Floor, Boston, MA 02110-1301, USA. 47 | ;; 48 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 49 | ;; 50 | ;;; Code: 51 | (require 'ert) 52 | (require 'snitch) 53 | (require 'use-package) 54 | (require 'snitch-custom) 55 | 56 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 57 | ;; 58 | ;; 59 | ;; Helper functions 60 | ;; 61 | ;; 62 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 63 | 64 | (defun snitch-test--save-vars (&optional deinit) 65 | "save all snitch globals so they can be restored after a test" 66 | (when deinit 67 | (snitch-test--cleanup)) 68 | (list snitch-network-policy 69 | snitch-network-blacklist 70 | snitch-network-whitelist 71 | snitch-process-policy 72 | snitch-process-blacklist 73 | snitch-process-whitelist 74 | snitch-log-policy 75 | snitch-log-verbose 76 | snitch-log-buffer-max-lines 77 | snitch-on-event-functions 78 | snitch-on-allow-functions 79 | snitch-on-block-functions 80 | snitch-on-whitelist-functions 81 | snitch-on-blacklist-functions 82 | snitch-log-functions)) 83 | 84 | (defun snitch-test--restore-vars (vars) 85 | "restore saved vars after a test" 86 | (setq snitch-network-policy (nth 0 vars)) 87 | (setq snitch-network-blacklist (nth 1 vars)) 88 | (setq snitch-network-whitelist (nth 2 vars)) 89 | (setq snitch-process-policy (nth 3 vars)) 90 | (setq snitch-process-blacklist (nth 4 vars)) 91 | (setq snitch-process-whitelist (nth 5 vars)) 92 | (setq snitch-log-policy (nth 6 vars)) 93 | (setq snitch-log-verbose (nth 7 vars)) 94 | (setq snitch-log-buffer-max-lines (nth 8 vars)) 95 | (setq snitch-on-event-functions (nth 9 vars)) 96 | (setq snitch-on-allow-functions (nth 10 vars)) 97 | (setq snitch-on-block-functions (nth 11 vars)) 98 | (setq snitch-on-whitelist-functions (nth 12 vars)) 99 | (setq snitch-on-blacklist-functions (nth 13 vars)) 100 | (setq snitch-log-functions (nth 14 vars))) 101 | 102 | (defun snitch-test--clear-vars (net-policy proc-policy &optional init) 103 | "set global vars to known defaults for duration of a test" 104 | (setq snitch-network-policy net-policy) 105 | (setq snitch-network-blacklist '()) 106 | (setq snitch-network-whitelist '()) 107 | (setq snitch-process-policy proc-policy) 108 | (setq snitch-process-blacklist '()) 109 | (setq snitch-process-whitelist '()) 110 | (setq snitch-log-policy '()) 111 | (setq snitch-log-verbose nil) 112 | (setq snitch-log-buffer-max-lines 1000) 113 | (setq snitch-on-event-functions '()) 114 | (setq snitch-on-allow-functions '()) 115 | (setq snitch-on-block-functions '()) 116 | (setq snitch-on-whitelist-functions '()) 117 | (setq snitch-on-blacklist-functions '()) 118 | (setq snitch-log-functions '()) 119 | (when init 120 | (snitch-mode +1))) 121 | 122 | (defun snitch-test--cleanup () 123 | "kill any spawned processes and restart snitch" 124 | (cl-loop for proc in (process-list) 125 | do (delete-process proc)) 126 | (snitch-mode -1)) 127 | 128 | (defun snitch-test--server (port) 129 | "launch a TCP server to receive connections" 130 | (make-network-process :name (format "ert-test-server-%s" port) 131 | :server t 132 | :host "127.0.0.1" 133 | :service port 134 | :family 'ipv4)) 135 | 136 | 137 | (defun snitch-test--net-client (port expect-success) 138 | "Make a network request to a TCP port. Assert t if allowed 139 | through the firewall, nil if blocked. Note that a refused 140 | connection still returns t, as it was allowed to pass." 141 | (let ((res (condition-case nil 142 | ;; returns nil if snitch blocks it, t if it makes a 143 | ;; connection 144 | (make-network-process :name "ert-test-net" 145 | :host "127.0.0.1" 146 | :service port 147 | :family 'ipv4) 148 | ;; error is success, because it means the connection 149 | ;; was allowed through the firewall and just failed to 150 | ;; reach a real host 151 | (error t)))) 152 | (should (if expect-success res (null res))))) 153 | 154 | (defun snitch-test--url-client (url expect-success) 155 | "Make a network request to a URL. Assert t if allowed through 156 | the firewall, nil if blocked. Note that a refused connection 157 | still returns t, as it was allowed to pass." 158 | ;; note: url-retrieve succeeds even if the server is not up, but 159 | ;; errors if snitch blocks it 160 | (let ((res (condition-case nil 161 | (url-retrieve url #'identity) 162 | (error nil)))) 163 | (should (if expect-success res (null res))))) 164 | 165 | (defun snitch-test--process (exe expected-success) 166 | "Launch a processes EXE. Assert that the firewall result 167 | matches EXPECTED-SUCCESS: t if allowed through, nil if blocked." 168 | (let ((res (make-process :name "ert-test-proc" :command (list exe)))) 169 | (should (if expected-success res (null res))))) 170 | 171 | (defun snitch-test--clear-logs () 172 | "clear the snitch log buffer" 173 | (with-current-buffer (get-buffer-create snitch--log-buffer-name) 174 | (setq buffer-read-only nil) 175 | (erase-buffer) 176 | (setq buffer-read-only t))) 177 | 178 | (defun snitch-test--get-log-entry (line) 179 | "get a single line from the log buffer (non-verbose)" 180 | (with-current-buffer (get-buffer-create snitch--log-buffer-name) 181 | (let ((line-count (count-lines (point-min) (point-max)))) 182 | (when (> line-count line) 183 | (goto-char (point-min)) 184 | (forward-line line) 185 | (beginning-of-line) 186 | (let* ((line (thing-at-point 'line)) 187 | (match (string-match "(\\([a-zA-Z]*\\)) -- #s(\\([a-zA-Z-]*\\)" line)) 188 | (event (match-string-no-properties 1 line)) 189 | (class (match-string-no-properties 2 line)) 190 | (props (text-properties-at (point)))) 191 | (list event class props)))))) 192 | 193 | (defun snitch-test--get-log-line-raw (line) 194 | "get a single line from the log buffer, unparsed" 195 | (with-current-buffer (get-buffer-create snitch--log-buffer-name) 196 | (let ((line-count (count-lines (point-min) (point-max)))) 197 | (when (> line-count line) 198 | (goto-char (point-min)) 199 | (forward-line line) 200 | (beginning-of-line) 201 | (thing-at-point 'line))))) 202 | 203 | (defun snitch-test--log-lines () 204 | "get the total number of lines in the snitch log buffer." 205 | (with-current-buffer (get-buffer-create snitch--log-buffer-name) 206 | (count-lines (point-min) (point-max)))) 207 | 208 | (defun snitch-test--get-verbose-log-entry () 209 | "Get the first verbose log in the log buffer. Only supports 210 | first entry in log buffer." 211 | (with-current-buffer (get-buffer-create snitch--log-buffer-name) 212 | (goto-char (point-min)) 213 | (forward-line 1) 214 | (let* ((start (point-min)) 215 | (end (search-forward-regexp "^\\[")) 216 | (line (replace-regexp-in-string "\n" "" (buffer-substring start (- end 1)))) 217 | (match (string-match "(\\([a-zA-Z]*\\)) --(\\([a-zA-Z-]*\\)" line)) 218 | (event (match-string-no-properties 1 line)) 219 | (class (match-string-no-properties 2 line)) 220 | (props (text-properties-at (point)))) 221 | (list event class props)))) 222 | 223 | (defun snitch-test--proc-entry (exe) 224 | "create a dummy process event" 225 | (snitch-process-entry 226 | :src-fn #'identity 227 | :src-path "~/.emacs.d/dummy/dummy.el" 228 | :src-pkg 'use-package 229 | :proc-name "ert-test-net" 230 | :executable exe 231 | :args '())) 232 | 233 | (defun snitch-test--net-entry (host) 234 | "create a dummy network event" 235 | (snitch-network-entry 236 | :src-fn #'identity 237 | :src-path "~/.emacs.d/dummy/dummy-net.el" 238 | :src-pkg 'use-package 239 | :proc-name "ert-test-proc" 240 | :host host 241 | :port 80 242 | :family 'ipv4)) 243 | 244 | (defun snitch-test--verify-mnemonic (plist) 245 | "verify that the fields of the mnemonic map match. That is, 246 | MNEMONIC-NAME equals NAME when the square brackets are removed, 247 | and KEY is the character in the square brackets." 248 | (let ((key (plist-get plist 'key)) 249 | (name (plist-get plist 'name)) 250 | (mnem-name (plist-get plist 'mnemonic-name))) 251 | (and (string-match (format "\\[%s\\]" key) mnem-name) 252 | (string-equal name 253 | (replace-regexp-in-string 254 | "\\(\\[\\|\\]\\)" "" mnem-name))))) 255 | 256 | (defun snitch-test--deepen-backtrace () 257 | "call snitch--backtrace from a slightly deeper function stack." 258 | (let ((lamb (lambda () (snitch--backtrace)))) 259 | (funcall lamb))) 260 | 261 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 262 | ;; 263 | ;; 264 | ;; Test cases: backtrace 265 | ;; 266 | ;; 267 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 268 | 269 | (ert-deftest snitch-test-backtrace () 270 | "Test that backtraces directly triggered by ert have the 271 | correct most-recent frames." 272 | ;; Running from ert triggers a backtrace like this: 273 | ;; 274 | ;;((lambda nil nil) 275 | ;; (ert--run-test-internal "/../emacs/28.0.50/lisp/emacs-lisp/ert.el" built-in) 276 | ;; (ert-run-test "/../emacs/28.0.50/lisp/emacs-lisp/ert.el" built-in) 277 | ;; (ert-run-or-rerun-test "/../emacs/28.0.50/lisp/emacs-lisp/ert.el" built-in) 278 | ;; (ert-run-tests "/../emacs/28.0.50/lisp/emacs-lisp/ert.el" built-in) 279 | ;; (ert "/../emacs/28.0.50/lisp/emacs-lisp/ert.el" built-in) 280 | ;; ...) 281 | ;; 282 | ;; The total backtrace can be 15+ deep, and the remaining ones 283 | ;; depend on how ert was initiated. 284 | ;; 285 | 286 | (let* ((backtrace (snitch--backtrace)) 287 | (frames (length backtrace))) 288 | (should (> frames 5)) 289 | ;; second frame: ert--run-test-internal 290 | (should (equal (nth 0 (nth 0 backtrace)) #'ert--run-test-internal)) 291 | (should (string-suffix-p "/emacs-lisp/ert.el" (nth 1 (nth 0 backtrace)))) 292 | (should (equal (nth 2 (nth 0 backtrace)) 'built-in)) 293 | ;; third frame: ert-run-test 294 | (should (equal (nth 0 (nth 1 backtrace)) #'ert-run-test)) 295 | (should (string-suffix-p "/emacs-lisp/ert.el" (nth 1 (nth 1 backtrace)))) 296 | (should (equal (nth 2 (nth 1 backtrace)) 'built-in)) 297 | ;; fourth frame: ert-run-or-rerun-test 298 | (should (equal (nth 0 (nth 2 backtrace)) #'ert-run-or-rerun-test)) 299 | (should (string-suffix-p "/emacs-lisp/ert.el" (nth 1 (nth 2 backtrace)))) 300 | (should (equal (nth 2 (nth 2 backtrace)) 'built-in)) 301 | ;; fifth frame: ert-run-tests 302 | (should (equal (nth 0 (nth 3 backtrace)) #'ert-run-tests)) 303 | (should (string-suffix-p "/emacs-lisp/ert.el" (nth 1 (nth 3 backtrace)))) 304 | (should (equal (nth 2 (nth 3 backtrace)) 'built-in)))) 305 | 306 | (ert-deftest snitch-test-backtrace-lambdas () 307 | "Test that backtraces get appropriately deeper when lambdas and 308 | functions are added to the call stack." 309 | (let* ((outer-backtrace (snitch--backtrace)) 310 | (middle-backtrace (funcall (lambda () (snitch--backtrace)))) 311 | (inner-backtrace (funcall (lambda () (snitch-test--deepen-backtrace)))) 312 | (outer-frames (length outer-backtrace)) 313 | (middle-frames (length middle-backtrace)) 314 | (inner-frames (length inner-backtrace))) 315 | (should (> inner-frames middle-frames)) 316 | (should (> middle-frames outer-frames)) 317 | ;; verify middle backtrace adds a lambda+funcall 318 | (should (equal (nth 0 (nth 0 middle-backtrace)) #'let*)) 319 | (should (equal (nth 0 (nth 1 middle-backtrace)) 'lambda)) 320 | (should (equal (nth 0 (nth 2 middle-backtrace)) #'ert--run-test-internal)) 321 | 322 | ;; verify inner backtrace adds a lambda+deepen+funcall 323 | (should (equal (nth 0 (nth 0 inner-backtrace)) #'let)) 324 | (should (equal (nth 0 (nth 1 inner-backtrace)) #'snitch-test--deepen-backtrace)) 325 | (should (equal (nth 0 (nth 2 inner-backtrace)) 'lambda)) 326 | (should (equal (nth 0 (nth 3 inner-backtrace)) #'funcall)) 327 | (should (equal (nth 0 (nth 4 inner-backtrace)) #'let*)) 328 | (should (equal (nth 0 (nth 5 inner-backtrace)) 'lambda)) 329 | (should (equal (nth 0 (nth 6 inner-backtrace)) #'ert--run-test-internal)))) 330 | 331 | (ert-deftest snitch-test-backtrace-timer () 332 | "Test that backtraces show correct details when sourced from a 333 | timer." 334 | (setq timer-bt nil) 335 | (run-with-timer 0 nil (lambda () (setq timer-bt (snitch--backtrace)))) 336 | (while (null timer-bt) (sleep-for 0.1)) 337 | (should (equal (nth 0 (nth 1 timer-bt)) #'timer-event-handler)) 338 | (should (string-suffix-p "/emacs-lisp/timer.el" (nth 1 (nth 1 timer-bt)))) 339 | (should (equal (nth 2 (nth 1 timer-bt)) 'site-lisp)) 340 | ;; TODO: test timer expansion 341 | ) 342 | 343 | (ert-deftest snitch-test-backtrace-use-package () 344 | "Test that backtraces show correct package source, in this case 345 | by wrapping error and calling a function that triggers it, so 346 | snitch--backtrace's caller originates in use-package." 347 | (setq bt nil) 348 | (let ((fn (lambda (&rest args) (setq bt (snitch--backtrace))))) 349 | (add-function :around (symbol-function 'error) fn) 350 | (use-package-only-one "label" '() #'identity) 351 | (while (null bt) (sleep-for 0.1)) 352 | (remove-function (symbol-function 'error) fn)) 353 | (should (equal (nth 0 (nth 2 bt)) #'use-package-only-one)) 354 | (should (string-suffix-p "/use-package-core.el" (nth 1 (nth 2 bt)))) 355 | ;; this is the important one 356 | (should (equal (nth 2 (nth 2 bt)) 'use-package))) 357 | 358 | (ert-deftest snitch-test-package-type-importance () 359 | "Test relative importance of package types." 360 | ;; nil > ? 361 | (should (not (null (snitch--package-type-more-important nil nil)))) 362 | (should (null (snitch--package-type-more-important nil 'built-in))) 363 | (should (null (snitch--package-type-more-important nil 'site-lisp))) 364 | (should (null (snitch--package-type-more-important nil 'user))) 365 | (should (null (snitch--package-type-more-important nil 'use-package))) 366 | ;; built-in > ? 367 | (should (not (null (snitch--package-type-more-important 'built-in nil)))) 368 | (should (not (null (snitch--package-type-more-important 'built-in 'built-in)))) 369 | (should (null (snitch--package-type-more-important 'built-in 'site-lisp))) 370 | (should (null (snitch--package-type-more-important 'built-in 'user))) 371 | (should (null (snitch--package-type-more-important 'built-in 'use-package))) 372 | ;; site-lisp > ? 373 | (should (not (null (snitch--package-type-more-important 'site-lisp nil)))) 374 | (should (not (null (snitch--package-type-more-important 'site-lisp 'built-in)))) 375 | (should (not (null (snitch--package-type-more-important 'site-lisp 'site-lisp)))) 376 | (should (null (snitch--package-type-more-important 'site-lisp 'user))) 377 | (should (null (snitch--package-type-more-important 'site-lisp 'use-package))) 378 | ;; user > ? 379 | (should (not (null (snitch--package-type-more-important 'user 'nil)))) 380 | (should (not (null (snitch--package-type-more-important 'user 'built-in)))) 381 | (should (not (null (snitch--package-type-more-important 'user 'site-lisp)))) 382 | (should (null (snitch--package-type-more-important 'user 'user))) 383 | (should (null (snitch--package-type-more-important 'user 'use-package))) 384 | ;; package > ? 385 | (should (not (null (snitch--package-type-more-important 'use-package 'nil)))) 386 | (should (not (null (snitch--package-type-more-important 'use-package 'built-in)))) 387 | (should (not (null (snitch--package-type-more-important 'use-package 'site-lisp)))) 388 | (should (not (null (snitch--package-type-more-important 'use-package 'user)))) 389 | (should (null (snitch--package-type-more-important 'use-package 'use-package)))) 390 | 391 | (ert-deftest snitch-test-responsible-caller () 392 | "Test that the correct item in the backtrace is marked as the 393 | responsible caller." 394 | (let* ((caller (snitch--responsible-caller (snitch--backtrace))) 395 | (fn (nth 0 caller))) 396 | (should (or 397 | ;; ert called from command line 398 | (equal fn #'ert-run-tests-batch-and-exit) 399 | ;; ert called from within emacs 400 | (equal fn #'ert) 401 | ;; ert called from with emacs with helm installed 402 | (equal fn #'helm-M-x-execute-command))))) 403 | 404 | 405 | 406 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 407 | ;; 408 | ;; 409 | ;; Test cases: network firewall 410 | ;; 411 | ;; 412 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 413 | 414 | (ert-deftest snitch-test-network-default-deny () 415 | "Test that network connections are denied when the default 416 | policy is set to deny." 417 | (let ((orig-vars (snitch-test--save-vars t)) 418 | (server1 (snitch-test--server 64221)) 419 | (server2 (snitch-test--server 64222))) 420 | ;; set allow policy 421 | (snitch-test--clear-vars 'deny 'allow t) 422 | 423 | (snitch-test--net-client 64221 nil) 424 | (snitch-test--net-client 64222 nil) 425 | (snitch-test--net-client 7744 nil) 426 | (snitch-test--url-client "http://127.0.0.1" nil) 427 | (snitch-test--url-client "https://127.0.0.1" nil) 428 | (snitch-test--url-client "http://127.0.0.1:64221" nil) 429 | 430 | ;; cleanup 431 | (snitch-test--restore-vars orig-vars) 432 | (snitch-test--cleanup))) 433 | 434 | 435 | (ert-deftest snitch-test-network-default-allow () 436 | "Test that network connections are permitted when the default 437 | policy is set to allow." 438 | (let ((orig-vars (snitch-test--save-vars t)) 439 | (server1 (snitch-test--server 64221)) 440 | (server2 (snitch-test--server 64222))) 441 | ;; set allow policy 442 | (snitch-test--clear-vars 'allow 'allow t) 443 | 444 | (snitch-test--net-client 64221 t) 445 | (snitch-test--net-client 7711 t) 446 | (snitch-test--url-client "http://127.0.0.1" t) 447 | (snitch-test--url-client "https://127.0.0.1" t) 448 | 449 | ;; cleanup 450 | (snitch-test--restore-vars orig-vars) 451 | (snitch-test--cleanup))) 452 | 453 | (ert-deftest snitch-test-network-blacklist () 454 | "Test that network connections are blocked when the policy is 455 | allow but the event matches a blacklist filter." 456 | (let ((orig-vars (snitch-test--save-vars t)) 457 | (server1 (snitch-test--server 64221)) 458 | (server2 (snitch-test--server 64222))) 459 | ;; set allow policy 460 | (snitch-test--clear-vars 'allow 'allow t) 461 | 462 | ;; both should be allowed by default 463 | (snitch-test--net-client 64221 t) 464 | (snitch-test--net-client 64222 t) 465 | 466 | ;; add the second to the blacklist 467 | (setq snitch-network-blacklist 468 | '(((lambda (evt port) (eq (oref evt port) port)) . (64222)))) 469 | 470 | ;; first allowed, second blacklisted 471 | (snitch-test--net-client 64221 t) 472 | (snitch-test--net-client 64222 nil) 473 | (snitch-test--url-client "http://127.0.0.1:64221" t) 474 | (snitch-test--url-client "http://127.0.0.1:64222" nil) 475 | 476 | ;;;; add both to the blacklist 477 | (add-to-list 'snitch-network-blacklist 478 | (cons (lambda (evt port) (eq (oref evt port) port)) 479 | (list 64221))) 480 | ;; all blacklisted 481 | (snitch-test--net-client 64221 nil) 482 | (snitch-test--net-client 64222 nil) 483 | (snitch-test--url-client "http://127.0.0.1:64221" nil) 484 | (snitch-test--url-client "http://127.0.0.1:64222" nil) 485 | 486 | ;; cleanup 487 | (snitch-test--restore-vars orig-vars) 488 | (snitch-test--cleanup))) 489 | 490 | (ert-deftest snitch-test-network-whitelist () 491 | "Test that network connections are allowed when the policy is 492 | deny but the event matches a whitelist filter." 493 | (let ((orig-vars (snitch-test--save-vars t)) 494 | (server1 (snitch-test--server 64221)) 495 | (server2 (snitch-test--server 64222))) 496 | ;; set deny policy 497 | (snitch-test--clear-vars 'deny 'allow t) 498 | 499 | ;; both should be denied by default 500 | (snitch-test--net-client 64221 nil) 501 | (snitch-test--net-client 64222 nil) 502 | 503 | ;; add the second to the whitelist 504 | (setq snitch-network-whitelist 505 | '(((lambda (evt port) (eq (oref evt port) port)) . (64222)))) 506 | 507 | ;; first denied, second whitelisted 508 | (snitch-test--net-client 64221 nil) 509 | (snitch-test--net-client 64222 t) 510 | (snitch-test--url-client "http://127.0.0.1:64221" nil) 511 | (snitch-test--url-client "http://127.0.0.1:64222" t) 512 | 513 | ;;;; add both to the whitelist 514 | (add-to-list 'snitch-network-whitelist 515 | (cons (lambda (evt port) (eq (oref evt port) port)) 516 | (list 64221))) 517 | ;; all permitted 518 | (snitch-test--net-client 64221 t) 519 | (snitch-test--net-client 64222 t) 520 | (snitch-test--url-client "http://127.0.0.1:64221" t) 521 | (snitch-test--url-client "http://127.0.0.1:64222" t) 522 | 523 | ;; cleanup 524 | (snitch-test--restore-vars orig-vars) 525 | (snitch-test--cleanup))) 526 | 527 | 528 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 529 | ;; 530 | ;; 531 | ;; Test cases: process firewall 532 | ;; 533 | ;; 534 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 535 | 536 | (ert-deftest snitch-test-process-default-deny () 537 | "Test that subprocesses are denied when the default policy is 538 | set to deny." 539 | (let ((orig-vars (snitch-test--save-vars t))) 540 | ;; set allow policy 541 | (snitch-test--clear-vars 'allow 'deny t) 542 | 543 | (snitch-test--process "ls" nil) 544 | 545 | ;; cleanup 546 | (snitch-test--restore-vars orig-vars) 547 | (snitch-test--cleanup))) 548 | 549 | 550 | (ert-deftest snitch-test-process-default-allow () 551 | "Test that subprocesses are permitted when the default policy 552 | is set to allow." 553 | (let ((orig-vars (snitch-test--save-vars t))) 554 | ;; set allow policy 555 | (snitch-test--clear-vars 'allow 'allow t) 556 | 557 | (snitch-test--process "ls" t) 558 | 559 | ;; cleanup 560 | (snitch-test--restore-vars orig-vars) 561 | (snitch-test--cleanup))) 562 | 563 | (ert-deftest snitch-test-process-blacklist () 564 | "Test that subprocesses are blocked when the policy is allow 565 | but the event matches a blacklist filter." 566 | (let ((orig-vars (snitch-test--save-vars t))) 567 | ;; set allow policy 568 | (snitch-test--clear-vars 'allow 'allow t) 569 | 570 | ;; both should be allowed by default 571 | (snitch-test--process "ls" t) 572 | (snitch-test--process "curl" t) 573 | 574 | ;; add the second to the blacklist 575 | (setq snitch-process-blacklist 576 | '(((lambda (evt exe) 577 | (string-equal (oref evt executable) exe)) . ("curl")))) 578 | 579 | ;; first allowed, second blacklisted 580 | (snitch-test--process "ls" t) 581 | (snitch-test--process "curl" nil) 582 | 583 | ;;;; add both to the blacklist 584 | (add-to-list 'snitch-process-blacklist 585 | (cons (lambda (evt exe) (string-equal (oref evt executable) exe)) 586 | (list "ls"))) 587 | ;; all blacklisted 588 | (snitch-test--process "ls" nil) 589 | (snitch-test--process "curl" nil) 590 | 591 | ;; cleanup 592 | (snitch-test--restore-vars orig-vars) 593 | (snitch-test--cleanup))) 594 | 595 | (ert-deftest snitch-test-process-whitelist () 596 | "Test that subprocesses are allowed when the policy is deny but 597 | the event matches a whitelist filter." 598 | (let ((orig-vars (snitch-test--save-vars t))) 599 | ;; set deny policy 600 | (snitch-test--clear-vars 'allow 'deny t) 601 | 602 | ;; both should be denied by default 603 | (snitch-test--process "ls" nil) 604 | (snitch-test--process "curl" nil) 605 | 606 | ;; add the second to the whitelist 607 | (setq snitch-process-whitelist 608 | '(((lambda (evt exe) 609 | (string-equal (oref evt executable) exe)) . ("curl")))) 610 | 611 | ;; first denied, second whitelisted 612 | (snitch-test--process "ls" nil) 613 | (snitch-test--process "curl" t) 614 | 615 | ;;;; add both to the whitelist 616 | (add-to-list 'snitch-process-whitelist 617 | (cons (lambda (evt exe) (string-equal (oref evt executable) exe)) 618 | (list "ls"))) 619 | ;; all whitelisted 620 | (snitch-test--process "ls" t) 621 | (snitch-test--process "curl" t) 622 | 623 | ;; cleanup 624 | (snitch-test--restore-vars orig-vars) 625 | (snitch-test--cleanup))) 626 | 627 | 628 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 629 | ;; 630 | ;; 631 | ;; Test cases: hooks 632 | ;; 633 | ;; 634 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 635 | 636 | (ert-deftest snitch-test-hooks-on-event () 637 | "Test that hooks are called upon receiving any event, and 638 | returning nil from a hook immediately blocks the event." 639 | (setq hook1-var 0) 640 | (setq hook2-var 0) 641 | (setq types '()) 642 | (let ((orig-vars (snitch-test--save-vars t)) 643 | (hook1 (lambda (type event) 644 | (add-to-list 'types type) 645 | (setq hook1-var (+ hook1-var 1)) t)) 646 | (hook2 (lambda (type event) (setq hook2-var (+ hook2-var 1)) t)) 647 | (hook3 (lambda (type event) nil))) 648 | (snitch-test--clear-vars 'allow 'allow t) 649 | 650 | ;; verify hooks run, but don’t change decision 651 | (setq snitch-on-event-functions (list hook1 hook2)) 652 | (snitch-test--url-client "http://127.0.0.1" t) 653 | (should (equal hook1-var 1)) 654 | (should (equal hook2-var 1)) 655 | (snitch-test--process "ls" t) 656 | (should (equal hook1-var 2)) 657 | (should (equal hook2-var 2)) 658 | 659 | ;; counter decision with final hook 660 | (setq snitch-on-event-functions (list hook1 hook2 hook3)) 661 | (snitch-test--process "ls" nil) 662 | (should (equal hook1-var 3)) 663 | (should (equal hook2-var 3)) 664 | 665 | ;; short-circuit with early hook 666 | (setq snitch-on-event-functions (list hook3 hook1 hook2)) 667 | (snitch-test--process "ls" nil) 668 | (should (equal hook1-var 3)) 669 | (should (equal hook2-var 3)) 670 | 671 | ;; verify hooks still run when denied 672 | (setq snitch-on-event-functions (list hook1 hook2)) 673 | (setq snitch-process-policy 'deny) 674 | (snitch-test--process "ls" nil) 675 | (should (equal hook1-var 4)) 676 | (should (equal hook2-var 4)) 677 | 678 | (should (eq 1 (length types))) 679 | (should (memq 'event types)) 680 | 681 | ;; cleanup 682 | (snitch-test--restore-vars orig-vars) 683 | (snitch-test--cleanup))) 684 | 685 | (ert-deftest snitch-test-hooks-on-allow () 686 | "Test that hooks are called when snitch decides to allow an 687 | event, and that returning nil from the hooks blocks the event." 688 | (setq hook1-var 0) 689 | (setq hook2-var 0) 690 | (setq types '()) 691 | (let ((orig-vars (snitch-test--save-vars t)) 692 | (hook1 (lambda (type event) 693 | (add-to-list 'types type) 694 | (setq hook1-var (+ hook1-var 1)) t)) 695 | (hook2 (lambda (type event) (setq hook2-var (+ hook2-var 1)) t)) 696 | (hook3 (lambda (type event) nil))) 697 | (snitch-test--clear-vars 'allow 'allow t) 698 | 699 | ;; Add to on-event as well, so it increments by 2 when allowed and 700 | ;; by 1 when denied. 701 | (setq snitch-on-event-functions (list hook1 hook2)) 702 | 703 | ;; verify hooks run, but don’t change decision 704 | (setq snitch-on-allow-functions (list hook1 hook2)) 705 | (snitch-test--url-client "http://127.0.0.1" t) 706 | (should (equal hook1-var 2)) 707 | (should (equal hook2-var 2)) 708 | (snitch-test--process "ls" t) 709 | (should (equal hook1-var 4)) 710 | (should (equal hook2-var 4)) 711 | 712 | ;; counter decision with final hook 713 | (setq snitch-on-allow-functions (list hook1 hook2 hook3)) 714 | (snitch-test--process "ls" nil) 715 | (should (equal hook1-var 6)) 716 | (should (equal hook2-var 6)) 717 | 718 | ;; short-circuit with early hook 719 | (setq snitch-on-allow-functions (list hook3 hook1 hook2)) 720 | (snitch-test--process "ls" nil) 721 | (should (equal hook1-var 7)) 722 | (should (equal hook2-var 7)) 723 | 724 | ;; verify hooks don’t run when snitch denies 725 | (setq snitch-on-allow-functions (list hook1 hook2)) 726 | (setq snitch-process-policy 'deny) 727 | (snitch-test--process "ls" nil) 728 | (should (equal hook1-var 8)) 729 | (should (equal hook2-var 8)) 730 | 731 | (should (eq 2 (length types))) 732 | (should (memq 'event types)) 733 | (should (memq 'allow types)) 734 | 735 | ;; cleanup 736 | (snitch-test--restore-vars orig-vars) 737 | (snitch-test--cleanup))) 738 | 739 | (ert-deftest snitch-test-hooks-on-block () 740 | "Test that hooks are called when snitch decides to block an 741 | event, and that returning nil causes snitch to accept the event." 742 | (setq hook1-var 0) 743 | (setq hook2-var 0) 744 | (setq types '()) 745 | (let ((orig-vars (snitch-test--save-vars t)) 746 | (hook1 (lambda (type event) 747 | (add-to-list 'types type) 748 | (setq hook1-var (+ hook1-var 1)) t)) 749 | (hook2 (lambda (type event) (setq hook2-var (+ hook2-var 1)) t)) 750 | (hook3 (lambda (type event) nil))) 751 | (snitch-test--clear-vars 'deny 'deny t) 752 | 753 | ;; Add to on-event as well, so it increments by 2 unless a hook 754 | ;; blocks it. 755 | (setq snitch-on-event-functions (list hook1 hook2)) 756 | 757 | ;; verify hooks run, but don’t change decision 758 | (setq snitch-on-block-functions (list hook1 hook2)) 759 | (snitch-test--url-client "http://127.0.0.1" nil) 760 | (should (equal hook1-var 2)) 761 | (should (equal hook2-var 2)) 762 | (snitch-test--process "ls" nil) 763 | (should (equal hook1-var 4)) 764 | (should (equal hook2-var 4)) 765 | 766 | ;; counter decision with final hook 767 | (setq snitch-on-block-functions (list hook1 hook2 hook3)) 768 | (snitch-test--process "ls" t) 769 | (should (equal hook1-var 6)) 770 | (should (equal hook2-var 6)) 771 | 772 | ;; short-circuit with early hook 773 | (setq snitch-on-block-functions (list hook3 hook1 hook2)) 774 | (snitch-test--process "ls" t) 775 | (should (equal hook1-var 7)) 776 | (should (equal hook2-var 7)) 777 | 778 | ;; verify hooks don’t run when snitch allows 779 | (setq snitch-on-block-functions (list hook1 hook2)) 780 | (setq snitch-process-policy 'allow) 781 | (snitch-test--process "ls" t) 782 | (should (equal hook1-var 8)) 783 | (should (equal hook2-var 8)) 784 | 785 | (should (eq 2 (length types))) 786 | (should (memq 'event types)) 787 | (should (memq 'block types)) 788 | 789 | ;; cleanup 790 | (snitch-test--restore-vars orig-vars) 791 | (snitch-test--cleanup))) 792 | 793 | (ert-deftest snitch-test-hooks-on-whitelist () 794 | "Test that hooks are called when snitch accepts an event 795 | because of a whitelist entry, and that returning nil causes 796 | snitch to block it." 797 | (setq hook1-var 0) 798 | (setq hook2-var 0) 799 | (setq types '()) 800 | (let ((orig-vars (snitch-test--save-vars t)) 801 | (hook1 (lambda (type event) 802 | (add-to-list 'types type) 803 | (setq hook1-var (+ hook1-var 1)) t)) 804 | (hook2 (lambda (type event) (setq hook2-var (+ hook2-var 1)) t)) 805 | (hook3 (lambda (type event) nil))) 806 | (snitch-test--clear-vars 'deny 'deny t) 807 | 808 | ;; Add to on-event as well, so it increments by 2 unless a hook 809 | ;; blocks it. 810 | (setq snitch-on-event-functions (list hook1 hook2)) 811 | 812 | ;; only whitelist ls process 813 | (setq snitch-process-whitelist 814 | '(((lambda (evt exe) 815 | (string-equal (oref evt executable) exe)) . ("ls")))) 816 | 817 | ;; verify hooks run, but don’t change decision 818 | (setq snitch-on-whitelist-functions (list hook1 hook2)) 819 | (snitch-test--process "ls" t) 820 | (should (equal hook1-var 2)) 821 | (should (equal hook2-var 2)) 822 | (snitch-test--process "ls" t) 823 | (should (equal hook1-var 4)) 824 | (should (equal hook2-var 4)) 825 | 826 | ;; counter decision with final hook 827 | (setq snitch-on-whitelist-functions (list hook1 hook2 hook3)) 828 | (snitch-test--process "ls" nil) 829 | (should (equal hook1-var 6)) 830 | (should (equal hook2-var 6)) 831 | 832 | ;; short-circuit with early hook 833 | (setq snitch-on-whitelist-functions (list hook3 hook1 hook2)) 834 | (snitch-test--process "ls" nil) 835 | (should (equal hook1-var 7)) 836 | (should (equal hook2-var 7)) 837 | 838 | ;; verify hooks don’t run with a non-whitelisted exe 839 | (setq snitch-on-whitelist-functions (list hook1 hook2)) 840 | (snitch-test--process "curl" nil) 841 | (should (equal hook1-var 8)) 842 | (should (equal hook2-var 8)) 843 | 844 | (should (eq 2 (length types))) 845 | (should (memq 'event types)) 846 | (should (memq 'whitelist types)) 847 | 848 | ;; cleanup 849 | (snitch-test--restore-vars orig-vars) 850 | (snitch-test--cleanup))) 851 | 852 | (ert-deftest snitch-test-hooks-on-blacklist () 853 | "Test that hooks are called when snitch decides to block an 854 | event because of the blacklist, and that returning nil causes 855 | snitch to accept it." 856 | (setq hook1-var 0) 857 | (setq hook2-var 0) 858 | (setq types '()) 859 | (let ((orig-vars (snitch-test--save-vars t)) 860 | (hook1 (lambda (type event) 861 | (add-to-list 'types type) 862 | (setq hook1-var (+ hook1-var 1)) t)) 863 | (hook2 (lambda (type event) (setq hook2-var (+ hook2-var 1)) t)) 864 | (hook3 (lambda (type event) nil))) 865 | (snitch-test--clear-vars 'allow 'allow t) 866 | 867 | ;; Add to on-event as well, so it increments by 2 unless a hook 868 | ;; blocks it. 869 | (setq snitch-on-event-functions (list hook1 hook2)) 870 | 871 | ;; only blacklist ls process 872 | (setq snitch-process-blacklist 873 | '(((lambda (evt exe) 874 | (string-equal (oref evt executable) exe)) . ("ls")))) 875 | 876 | ;; verify hooks run, but don’t change decision 877 | (setq snitch-on-blacklist-functions (list hook1 hook2)) 878 | (snitch-test--process "ls" nil) 879 | (should (equal hook1-var 2)) 880 | (should (equal hook2-var 2)) 881 | (snitch-test--process "ls" nil) 882 | (should (equal hook1-var 4)) 883 | (should (equal hook2-var 4)) 884 | 885 | ;; counter decision with final hook 886 | (setq snitch-on-blacklist-functions (list hook1 hook2 hook3)) 887 | (snitch-test--process "ls" t) 888 | (should (equal hook1-var 6)) 889 | (should (equal hook2-var 6)) 890 | 891 | ;; short-circuit with early hook 892 | (setq snitch-on-blacklist-functions (list hook3 hook1 hook2)) 893 | (snitch-test--process "ls" t) 894 | (should (equal hook1-var 7)) 895 | (should (equal hook2-var 7)) 896 | 897 | ;; verify hooks don’t run with a non-blacklisted exe 898 | (setq snitch-on-blacklist-functions (list hook1 hook2)) 899 | (snitch-test--process "curl" t) 900 | (should (equal hook1-var 8)) 901 | (should (equal hook2-var 8)) 902 | 903 | (should (eq 2 (length types))) 904 | (should (memq 'event types)) 905 | (should (memq 'blacklist types)) 906 | 907 | ;; cleanup 908 | (snitch-test--restore-vars orig-vars) 909 | (snitch-test--cleanup))) 910 | 911 | (ert-deftest snitch-test-log-hooks () 912 | "Test that hooks are called when snitch emits a log message. 913 | Tests passing, blocking, and modifying log messages." 914 | (setq hook1-var 0) 915 | (setq hook2-var 0) 916 | (let ((orig-vars (snitch-test--save-vars t)) 917 | (hook1 (lambda (msg) (setq hook1-var (1+ hook1-var)) t)) 918 | (hook2 (lambda (msg) 919 | (setq hook2-var (1+ hook2-var)) 920 | (cond 921 | ((equal (get-text-property 0 'snitch-executable msg) "curl") 922 | "filtered out curl message\n") 923 | ((equal (get-text-property 0 'snitch-executable msg) "ls") 924 | nil) 925 | (t t))))) 926 | (snitch-test--clear-vars 'allow 'allow t) 927 | (setq snitch-log-policy '(allowed)) 928 | 929 | ;; All messages allowed 930 | (setq snitch-log-functions (list hook1)) 931 | (snitch-test--clear-logs) 932 | 933 | (snitch-test--process "ls" t) 934 | (snitch-test--process "curl" t) 935 | (snitch-test--process "whoami" t) 936 | (should (eq hook1-var 3)) 937 | (should (eq hook2-var 0)) 938 | (should (eq (snitch-test--log-lines) 3)) 939 | 940 | ;; Some messages filtered 941 | (setq snitch-log-functions (list hook1 hook2 hook1)) 942 | (snitch-test--clear-logs) 943 | 944 | ;; hook1 run once (hook2 terminates) 945 | (snitch-test--process "ls" t) 946 | (should (eq hook1-var 4)) 947 | (should (eq hook2-var 1)) 948 | ;; ls blocked, nothing in log 949 | (should (eq (snitch-test--log-lines) 0)) 950 | 951 | ;; hook1 run once (hook2 terminates) 952 | (snitch-test--process "curl" t) 953 | (should (eq hook1-var 5)) 954 | (should (eq hook2-var 2)) 955 | (should (eq (snitch-test--log-lines) 1)) 956 | (should (string-match "filtered out curl" 957 | (snitch-test--get-log-line-raw 0))) 958 | 959 | 960 | ;; hook1 run twice (hook2 passes) 961 | (snitch-test--process "whoami" t) 962 | (should (eq hook1-var 7)) 963 | (should (eq hook2-var 3)) 964 | (should (eq (snitch-test--log-lines) 2)) 965 | 966 | ;; cleanup 967 | (snitch-test--restore-vars orig-vars) 968 | (snitch-test--cleanup))) 969 | 970 | 971 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 972 | ;; 973 | ;; 974 | ;; Test cases: logging 975 | ;; 976 | ;; 977 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 978 | 979 | (ert-deftest snitch-test-log-policy-matcher () 980 | "Test that the decisions on whether an event should be log 981 | match the snitch-log-policy." 982 | (let ((orig-vars (snitch-test--save-vars t))) 983 | (snitch-test--clear-vars 'allow 'allow t) 984 | 985 | (setq snitch-log-policy '(all)) 986 | (should (snitch--log-policy-match '(all))) 987 | (should (snitch--log-policy-match '(whitelisted))) 988 | (should (snitch--log-policy-match '(network-whitelisted))) 989 | (should (snitch--log-policy-match '(process-whitelisted))) 990 | (should (snitch--log-policy-match '(blacklisted))) 991 | (should (snitch--log-policy-match '(network-blacklisted))) 992 | (should (snitch--log-policy-match '(process-blacklisted))) 993 | (should (snitch--log-policy-match '(allowed))) 994 | (should (snitch--log-policy-match '(network-allowed))) 995 | (should (snitch--log-policy-match '(process-allowed))) 996 | (should (snitch--log-policy-match '(blocked))) 997 | (should (snitch--log-policy-match '(network-blocked))) 998 | (should (snitch--log-policy-match '(process-blocked))) 999 | 1000 | (setq snitch-log-policy '(blacklisted)) 1001 | (should (null (snitch--log-policy-match '(all)))) 1002 | (should (null (snitch--log-policy-match '(whitelisted)))) 1003 | (should (null (snitch--log-policy-match '(network-whitelisted)))) 1004 | (should (null (snitch--log-policy-match '(process-whitelisted)))) 1005 | (should (snitch--log-policy-match '(blacklisted))) 1006 | (should (snitch--log-policy-match '(network-blacklisted))) 1007 | (should (snitch--log-policy-match '(process-blacklisted))) 1008 | (should (snitch--log-policy-match '(blacklisted whitelisted))) 1009 | (should (null (snitch--log-policy-match '(allowed)))) 1010 | (should (null (snitch--log-policy-match '(network-allowed)))) 1011 | (should (null (snitch--log-policy-match '(process-allowed)))) 1012 | (should (null (snitch--log-policy-match '(blocked)))) 1013 | (should (null (snitch--log-policy-match '(network-blocked)))) 1014 | (should (null (snitch--log-policy-match '(process-blocked)))) 1015 | 1016 | (setq snitch-log-policy '(whitelisted)) 1017 | (should (snitch--log-policy-match '(whitelisted))) 1018 | (should (snitch--log-policy-match '(network-whitelisted))) 1019 | (should (snitch--log-policy-match '(process-whitelisted))) 1020 | (should (snitch--log-policy-match '(blacklisted whitelisted))) 1021 | (should (null (snitch--log-policy-match '(blacklisted)))) 1022 | (should (null (snitch--log-policy-match '(network-blacklisted)))) 1023 | (should (null (snitch--log-policy-match '(process-blacklisted)))) 1024 | (should (null (snitch--log-policy-match '(allowed)))) 1025 | (should (null (snitch--log-policy-match '(blocked)))) 1026 | 1027 | (setq snitch-log-policy '(allowed)) 1028 | (should (snitch--log-policy-match '(network-allowed))) 1029 | 1030 | (setq snitch-log-policy '(whitelisted allowed)) 1031 | (should (snitch--log-policy-match '(whitelisted))) 1032 | (should (snitch--log-policy-match '(network-whitelisted))) 1033 | (should (snitch--log-policy-match '(process-whitelisted))) 1034 | (should (snitch--log-policy-match '(whitelisted blacklisted))) 1035 | (should (null (snitch--log-policy-match '(blacklisted)))) 1036 | (should (null (snitch--log-policy-match '(network-blacklisted)))) 1037 | (should (null (snitch--log-policy-match '(process-blacklisted)))) 1038 | (should (snitch--log-policy-match '(allowed))) 1039 | (should (snitch--log-policy-match '(network-allowed))) 1040 | (should (snitch--log-policy-match '(process-allowed))) 1041 | (should (snitch--log-policy-match '(allowed whitelisted))) 1042 | (should (snitch--log-policy-match '(allowed whitelisted blacklisted))) 1043 | (should (null (snitch--log-policy-match '(blocked)))) 1044 | (should (null (snitch--log-policy-match '(blocked blacklisted)))) 1045 | 1046 | ;; cleanup 1047 | (snitch-test--restore-vars orig-vars) 1048 | (snitch-test--cleanup))) 1049 | 1050 | (ert-deftest snitch-test-log-all () 1051 | "Test that the right log events are received when logging all 1052 | events." 1053 | (let ((orig-vars (snitch-test--save-vars t))) 1054 | (snitch-test--clear-vars 'allow 'deny t) 1055 | 1056 | (setq snitch-log-policy '(all)) 1057 | 1058 | (snitch-test--clear-logs) 1059 | (snitch-test--url-client "http://127.0.0.1" t) 1060 | 1061 | ;; first line is the arrival 1062 | (pcase-let ((`(,event ,class ,props) (snitch-test--get-log-entry 0))) 1063 | (should (string-equal event "event")) 1064 | (should (string-equal class "snitch-network-entry")) 1065 | (should (string-equal (plist-get props 'snitch-host) "127.0.0.1"))) 1066 | ;; second line is the decision (allow) 1067 | (pcase-let ((`(,event ,class ,props) (snitch-test--get-log-entry 1))) 1068 | (should (string-equal event "allowed")) 1069 | (should (string-equal class "snitch-network-entry")) 1070 | (should (string-equal (plist-get props 'snitch-host) "127.0.0.1"))) 1071 | (should (null (snitch-test--get-log-entry 2))) 1072 | 1073 | (snitch-test--clear-logs) 1074 | (snitch-test--process "ls" nil) 1075 | ;; first line is the arrival 1076 | (pcase-let ((`(,event ,class ,props) (snitch-test--get-log-entry 0))) 1077 | (should (string-equal event "event")) 1078 | (should (string-equal class "snitch-process-entry")) 1079 | (should (string-equal (plist-get props 'snitch-executable) "ls"))) 1080 | ;; second line is the decision (blocked) 1081 | (pcase-let ((`(,event ,class ,props) (snitch-test--get-log-entry 1))) 1082 | (should (string-equal event "blocked")) 1083 | (should (string-equal class "snitch-process-entry")) 1084 | (should (string-equal (plist-get props 'snitch-executable) "ls"))) 1085 | (should (null (snitch-test--get-log-entry 2))) 1086 | 1087 | ;; cleanup 1088 | (snitch-test--restore-vars orig-vars) 1089 | (snitch-test--cleanup))) 1090 | 1091 | (ert-deftest snitch-test-log-allowed () 1092 | "Test that the right log events are received when logging only 1093 | allowed events." 1094 | (let ((orig-vars (snitch-test--save-vars t))) 1095 | (snitch-test--clear-vars 'allow 'allow t) 1096 | 1097 | (setq snitch-log-policy '(allowed)) 1098 | (snitch-test--clear-logs) 1099 | (snitch-test--url-client "http://127.0.0.1" t) 1100 | (pcase-let ((`(,event ,class ,props) (snitch-test--get-log-entry 0))) 1101 | (should (string-equal event "allowed")) 1102 | (should (string-equal class "snitch-network-entry")) 1103 | (should (string-equal (plist-get props 'snitch-host) "127.0.0.1"))) 1104 | (should (null (snitch-test--get-log-entry 1))) 1105 | 1106 | (setq snitch-log-policy '(network-allowed)) 1107 | (snitch-test--clear-logs) 1108 | (snitch-test--url-client "http://127.0.0.1" t) 1109 | (pcase-let ((`(,event ,class ,props) (snitch-test--get-log-entry 0))) 1110 | (should (string-equal event "allowed")) 1111 | (should (string-equal class "snitch-network-entry")) 1112 | (should (string-equal (plist-get props 'snitch-host) "127.0.0.1"))) 1113 | (should (null (snitch-test--get-log-entry 1))) 1114 | 1115 | (setq snitch-log-policy '(process-allowed)) 1116 | (snitch-test--clear-logs) 1117 | (snitch-test--url-client "http://127.0.0.1" t) 1118 | (should (null (snitch-test--get-log-entry 0))) 1119 | 1120 | (setq snitch-log-policy '(process-allowed)) 1121 | (snitch-test--clear-logs) 1122 | (snitch-test--process "ls" t) 1123 | (pcase-let ((`(,event ,class ,props) (snitch-test--get-log-entry 0))) 1124 | (should (string-equal event "allowed")) 1125 | (should (string-equal class "snitch-process-entry")) 1126 | (should (string-equal (plist-get props 'snitch-executable) "ls"))) 1127 | (should (null (snitch-test--get-log-entry 1))) 1128 | 1129 | ;; cleanup 1130 | (snitch-test--restore-vars orig-vars) 1131 | (snitch-test--cleanup))) 1132 | 1133 | (ert-deftest snitch-test-log-blocked () 1134 | "Test that the right log events are received when logging only 1135 | blocked events." 1136 | (let ((orig-vars (snitch-test--save-vars t))) 1137 | (snitch-test--clear-vars 'deny 'deny t) 1138 | 1139 | (setq snitch-log-policy '(blocked)) 1140 | (snitch-test--clear-logs) 1141 | (snitch-test--url-client "http://127.0.0.1" nil) 1142 | (pcase-let ((`(,event ,class ,props) (snitch-test--get-log-entry 0))) 1143 | (should (string-equal event "blocked")) 1144 | (should (string-equal class "snitch-network-entry")) 1145 | (should (string-equal (plist-get props 'snitch-host) "127.0.0.1"))) 1146 | (should (null (snitch-test--get-log-entry 1))) 1147 | 1148 | (setq snitch-log-policy '(network-blocked)) 1149 | (snitch-test--clear-logs) 1150 | (snitch-test--url-client "http://127.0.0.1" nil) 1151 | (pcase-let ((`(,event ,class ,props) (snitch-test--get-log-entry 0))) 1152 | (should (string-equal event "blocked")) 1153 | (should (string-equal class "snitch-network-entry")) 1154 | (should (string-equal (plist-get props 'snitch-host) "127.0.0.1"))) 1155 | (should (null (snitch-test--get-log-entry 1))) 1156 | 1157 | (setq snitch-log-policy '(process-blocked)) 1158 | (snitch-test--clear-logs) 1159 | (snitch-test--url-client "http://127.0.0.1" nil) 1160 | (should (null (snitch-test--get-log-entry 0))) 1161 | 1162 | (setq snitch-log-policy '(process-blocked)) 1163 | (snitch-test--clear-logs) 1164 | (snitch-test--process "ls" nil) 1165 | (pcase-let ((`(,event ,class ,props) (snitch-test--get-log-entry 0))) 1166 | (should (string-equal event "blocked")) 1167 | (should (string-equal class "snitch-process-entry")) 1168 | (should (string-equal (plist-get props 'snitch-executable) "ls"))) 1169 | (should (null (snitch-test--get-log-entry 1))) 1170 | 1171 | ;; cleanup 1172 | (snitch-test--restore-vars orig-vars) 1173 | (snitch-test--cleanup))) 1174 | 1175 | (ert-deftest snitch-test-log-whitelisted () 1176 | "Test that the right log events are received when logging only 1177 | whitelisted events." 1178 | (let ((orig-vars (snitch-test--save-vars t))) 1179 | (snitch-test--clear-vars 'deny 'deny t) 1180 | 1181 | (setq snitch-network-whitelist 1182 | '(((lambda (evt host) 1183 | (string-equal (oref evt host) host)) . ("127.0.0.1")))) 1184 | (setq snitch-process-whitelist 1185 | '(((lambda (evt exe) 1186 | (string-equal (oref evt executable) exe)) . ("ls")))) 1187 | 1188 | (setq snitch-log-policy '(whitelisted)) 1189 | (snitch-test--clear-logs) 1190 | (snitch-test--url-client "http://127.0.0.1" t) 1191 | (pcase-let ((`(,event ,class ,props) (snitch-test--get-log-entry 0))) 1192 | (should (string-equal event "whitelisted")) 1193 | (should (string-equal class "snitch-network-entry")) 1194 | (should (string-equal (plist-get props 'snitch-host) "127.0.0.1"))) 1195 | (should (null (snitch-test--get-log-entry 1))) 1196 | 1197 | (setq snitch-log-policy '(network-whitelisted)) 1198 | (snitch-test--clear-logs) 1199 | (snitch-test--url-client "http://127.0.0.1" t) 1200 | (pcase-let ((`(,event ,class ,props) (snitch-test--get-log-entry 0))) 1201 | (should (string-equal event "whitelisted")) 1202 | (should (string-equal class "snitch-network-entry")) 1203 | (should (string-equal (plist-get props 'snitch-host) "127.0.0.1"))) 1204 | (should (null (snitch-test--get-log-entry 1))) 1205 | 1206 | (setq snitch-log-policy '(process-whitelisted)) 1207 | (snitch-test--clear-logs) 1208 | (snitch-test--url-client "http://127.0.0.1" t) 1209 | (should (null (snitch-test--get-log-entry 0))) 1210 | 1211 | (setq snitch-log-policy '(process-whitelisted)) 1212 | (snitch-test--clear-logs) 1213 | (snitch-test--process "ls" t) 1214 | (pcase-let ((`(,event ,class ,props) (snitch-test--get-log-entry 0))) 1215 | (should (string-equal event "whitelisted")) 1216 | (should (string-equal class "snitch-process-entry")) 1217 | (should (string-equal (plist-get props 'snitch-executable) "ls"))) 1218 | (should (null (snitch-test--get-log-entry 1))) 1219 | 1220 | ;; cleanup 1221 | (snitch-test--restore-vars orig-vars) 1222 | (snitch-test--cleanup))) 1223 | 1224 | (ert-deftest snitch-test-log-blacklisted () 1225 | "Test that the right log events are received when logging only 1226 | blacklisted events." 1227 | (let ((orig-vars (snitch-test--save-vars t))) 1228 | (snitch-test--clear-vars 'allow 'allow t) 1229 | 1230 | (setq snitch-network-blacklist 1231 | '(((lambda (evt host) 1232 | (string-equal (oref evt host) host)) . ("127.0.0.1")))) 1233 | (setq snitch-process-blacklist 1234 | '(((lambda (evt exe) 1235 | (string-equal (oref evt executable) exe)) . ("ls")))) 1236 | 1237 | (setq snitch-log-policy '(blacklisted)) 1238 | (snitch-test--clear-logs) 1239 | (snitch-test--url-client "http://127.0.0.1" nil) 1240 | (pcase-let ((`(,event ,class ,props) (snitch-test--get-log-entry 0))) 1241 | (should (string-equal event "blacklisted")) 1242 | (should (string-equal class "snitch-network-entry")) 1243 | (should (string-equal (plist-get props 'snitch-host) "127.0.0.1"))) 1244 | (should (null (snitch-test--get-log-entry 1))) 1245 | 1246 | (setq snitch-log-policy '(network-blacklisted)) 1247 | (snitch-test--clear-logs) 1248 | (snitch-test--url-client "http://127.0.0.1" nil) 1249 | (pcase-let ((`(,event ,class ,props) (snitch-test--get-log-entry 0))) 1250 | (should (string-equal event "blacklisted")) 1251 | (should (string-equal class "snitch-network-entry")) 1252 | (should (string-equal (plist-get props 'snitch-host) "127.0.0.1"))) 1253 | (should (null (snitch-test--get-log-entry 1))) 1254 | 1255 | (setq snitch-log-policy '(process-blacklisted)) 1256 | (snitch-test--clear-logs) 1257 | (snitch-test--url-client "http://127.0.0.1" nil) 1258 | (should (null (snitch-test--get-log-entry 0))) 1259 | 1260 | (setq snitch-log-policy '(process-blacklisted)) 1261 | (snitch-test--clear-logs) 1262 | (snitch-test--process "ls" nil) 1263 | (pcase-let ((`(,event ,class ,props) (snitch-test--get-log-entry 0))) 1264 | (should (string-equal event "blacklisted")) 1265 | (should (string-equal class "snitch-process-entry")) 1266 | (should (string-equal (plist-get props 'snitch-executable) "ls"))) 1267 | (should (null (snitch-test--get-log-entry 1))) 1268 | 1269 | ;; cleanup 1270 | (snitch-test--restore-vars orig-vars) 1271 | (snitch-test--cleanup))) 1272 | 1273 | (ert-deftest snitch-test-log-prune () 1274 | "Test that the log buffer can be pruned to a limited side." 1275 | (let ((orig-vars (snitch-test--save-vars t))) 1276 | (snitch-test--clear-vars 'allow 'allow t) 1277 | 1278 | (setq snitch-log-policy '(all)) 1279 | (snitch-test--clear-logs) 1280 | 1281 | ;; make 40 logs (2 per connection) 1282 | (dotimes (i 20) (snitch-test--process "ls" t)) 1283 | (should (eq 40 (snitch-test--log-lines))) 1284 | 1285 | (setq snitch-log-buffer-max-lines 30) 1286 | (snitch--prune-log-buffer) 1287 | (should (eq 30 (snitch-test--log-lines))) 1288 | 1289 | (setq snitch-log-buffer-max-lines 10) 1290 | (snitch--prune-log-buffer) 1291 | (should (eq 10 (snitch-test--log-lines))) 1292 | 1293 | (setq snitch-log-buffer-max-lines 1) 1294 | (snitch--prune-log-buffer) 1295 | (should (eq 1 (snitch-test--log-lines))) 1296 | 1297 | ;; cleanup 1298 | (snitch-test--restore-vars orig-vars) 1299 | (snitch-test--cleanup))) 1300 | 1301 | (ert-deftest snitch-test-log-prune-timer () 1302 | "Test that the log pruning timer prunes the log correctly." 1303 | (let ((orig-vars (snitch-test--save-vars t))) 1304 | (snitch-test--clear-vars 'allow 'allow t) 1305 | 1306 | (setq snitch-log-policy '(all)) 1307 | (snitch-test--clear-logs) 1308 | 1309 | ;; make 10 logs (2 per connection) 1310 | (dotimes (i 5) (snitch-test--process "ls" t)) 1311 | (should (eq 10 (snitch-test--log-lines))) 1312 | 1313 | (setq snitch-log-buffer-max-lines 5) 1314 | (snitch--start-log-prune-timer) 1315 | (timer-set-idle-time snitch--log-prune-timer 0) 1316 | (timer-activate snitch--log-prune-timer) 1317 | (sleep-for 0.5) 1318 | (should (eq 5 (snitch-test--log-lines))) 1319 | (should (null snitch--log-prune-timer)) 1320 | 1321 | ;; cleanup 1322 | (snitch-test--restore-vars orig-vars) 1323 | (snitch-test--cleanup))) 1324 | 1325 | (ert-deftest snitch-test-log-verbose () 1326 | "Test that the log buffer receives larger verbose logs when 1327 | snitch-log-verbose is t." 1328 | (let ((orig-vars (snitch-test--save-vars t))) 1329 | (snitch-test--clear-vars 'allow 'allow t) 1330 | 1331 | (setq snitch-log-policy '(all)) 1332 | (setq snitch-log-verbose t) 1333 | (snitch-test--clear-logs) 1334 | (snitch-test--process "ls" t) 1335 | 1336 | (pcase-let ((`(,event ,class ,props) (snitch-test--get-verbose-log-entry))) 1337 | (should (string-equal event "event")) 1338 | (should (string-equal class "snitch-process-entry")) 1339 | (should (string-equal (plist-get props 'snitch-executable) "ls"))) 1340 | 1341 | ;; cleanup 1342 | (snitch-test--restore-vars orig-vars) 1343 | (snitch-test--cleanup))) 1344 | 1345 | 1346 | 1347 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1348 | ;; 1349 | ;; 1350 | ;; Test cases: log filter UI 1351 | ;; 1352 | ;; 1353 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1354 | 1355 | (ert-deftest snitch-test-log-filter-mnemonics () 1356 | "Test that the name/mnemonic name/key shortcut mappings all 1357 | match for every display line of the log filter UI." 1358 | (let* ((proc-event (snitch-test--proc-entry "ls")) 1359 | (net-event (snitch-test--net-entry "127.0.0.1")) 1360 | (proc-map (snitch--log-filter-map proc-event)) 1361 | (net-map (snitch--log-filter-map net-event))) 1362 | ;; common fields 1363 | (should (snitch-test--verify-mnemonic (alist-get 'src-fn net-map))) 1364 | (should (snitch-test--verify-mnemonic (alist-get 'src-fn proc-map))) 1365 | (should (snitch-test--verify-mnemonic (alist-get 'src-path net-map))) 1366 | (should (snitch-test--verify-mnemonic (alist-get 'src-path proc-map))) 1367 | (should (snitch-test--verify-mnemonic (alist-get 'src-pkg net-map))) 1368 | (should (snitch-test--verify-mnemonic (alist-get 'src-pkg proc-map))) 1369 | (should (snitch-test--verify-mnemonic (alist-get 'proc-name net-map))) 1370 | (should (snitch-test--verify-mnemonic (alist-get 'proc-name proc-map))) 1371 | ;; net fields 1372 | (should (snitch-test--verify-mnemonic (alist-get 'host net-map))) 1373 | (should (snitch-test--verify-mnemonic (alist-get 'port net-map))) 1374 | (should (snitch-test--verify-mnemonic (alist-get 'family net-map))) 1375 | ;; proc fields 1376 | (should (snitch-test--verify-mnemonic (alist-get 'executable proc-map))) 1377 | (should (snitch-test--verify-mnemonic (alist-get 'args proc-map))))) 1378 | 1379 | (ert-deftest snitch-test-log-filter-popup-hook () 1380 | "Test that the user hook is called when the log filter buffer 1381 | is shown or hidden." 1382 | (setq hook1-var 0) 1383 | (let ((orig-vars (snitch-test--save-vars t)) 1384 | (hook1 (lambda () (setq hook1-var (+ hook1-var 1)) t))) 1385 | (snitch-test--clear-vars 'allow 'allow t) 1386 | 1387 | (setq snitch-log-filter-window-open-hook (list hook1)) 1388 | (setq snitch-log-filter-window-close-hook (list hook1)) 1389 | (snitch--init-log-filter-buffer) 1390 | (snitch--show-log-filter-window) 1391 | (should (equal 1 hook1-var)) 1392 | (snitch--hide-log-filter-window snitch--log-filter-buffer) 1393 | (should (equal 2 hook1-var)) 1394 | 1395 | ;; cleanup 1396 | (snitch-test--restore-vars orig-vars) 1397 | (snitch-test--cleanup))) 1398 | 1399 | 1400 | 1401 | 1402 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1403 | ;; 1404 | ;; 1405 | ;; Manual tests and notes and scratch area 1406 | ;; 1407 | ;; 1408 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1409 | 1410 | (defun snitch--test-wrap-process () 1411 | (setq snitch-log-verbose nil) 1412 | (make-process :name "poop" :command '("ls" "-l"))) 1413 | 1414 | (defun snitch--test-wrap-network-process () 1415 | (make-network-process :name "netpoop" :host "blommorna.com" :service 443 :family 'ipv4) 1416 | (url-retrieve "http://google.com" #'identity) 1417 | (setq snitch-log-buffer-max-lines 5)) 1418 | 1419 | 1420 | (defun snitch--test-log-filter-buffer () 1421 | (snitch--run-log-filter-wizard (snitch-network-entry :src-path "/hello"))) 1422 | 1423 | (defun snitch--test-package-from-path () 1424 | (snitch--package-from-path "/home/trevor/.emacs.d/elpa/elfeed-20200910.239/elfeed.el") 1425 | (snitch--package-from-path "/usr/share/emacs/27.1/lisp/simple.el") 1426 | (snitch--package-from-path "/usr/share/emacs/27.1/lisp/emacs-lisp/backtrace.el.gz") 1427 | (snitch--package-from-path "/home/trevor/.emacs.d/firewall_test.el")) 1428 | 1429 | (defun snitch--test-backtrace() 1430 | (snitch--backtrace)) 1431 | 1432 | (defun snitch--test-responsible-caller () 1433 | (message "\n\n\nbacktrace:\n%s" (snitch--backtrace)) 1434 | (snitch--responsible-caller (snitch--backtrace))) 1435 | 1436 | 1437 | ;; (let* ((frames (backtrace-frames)) 1438 | ;; (elt (nth 0 frames))) 1439 | ;; (backtrace-print-to-string elt)) 1440 | 1441 | 1442 | ;; (car (snitch--test-backtrace)) 1443 | ;; (subrp 'make-network-process) 1444 | ;; (subrp 'let) 1445 | ;; (subrp 'backtrace) 1446 | ;; (commandp 'let) 1447 | ;; (symbolp 'let) 1448 | ;; (subr-arity (symbol-function 'let)) 1449 | ;; (commandp 'progn) 1450 | ;; (package-built-in-p 'backtrace) 1451 | ;; (memq 'simple package-activated-list) 1452 | ;; (package-installed-p 'simple) 1453 | ;; (featurep 'simple) 1454 | ;; (elisp-load-path-roots) 1455 | ;; (site-lisp-dirs) 1456 | ;; (site-lisp-roots) 1457 | ;; (dir-in-site-lisp "/usr/share/emacs/27.1/lisp/blah") 1458 | 1459 | 1460 | ;; ;; check if package is loaded 1461 | ;; (memq 'elfeed package-activated-list) 1462 | ;; ;; check if package is built-in 1463 | ;; (package-built-in-p 'package) 1464 | ;; ;; list all available packages 1465 | ;; (package--alist) 1466 | ;; ;; get pkg-desc (tuple) for an installed package 1467 | ;; (alist-get 'elfeed (package--alist)) 1468 | ;; ;; get directory of installed package 1469 | ;; (package-desc-dir (car (cdr (assoc 'elfeed (package--alist))))) 1470 | ;; 1471 | ;; ;; return package-desc of current buffer. can navigate to buffer 1472 | ;; ;; in stack trace and call this? 1473 | ;; (package-buffer-info) 1474 | ;; ;; same as above, but for the whole dir open in dired-mode 1475 | ;; (pcakage-dir-info) 1476 | ;; (symbol-file 'elfeed) 1477 | ;; (featurep 'elfeed) 1478 | ;; (symbol-name 'elfeed) 1479 | ;; (package--list-loaded-files "/home/trevor/.emacs.d/elpa/elfeed-20200910.239") 1480 | ;; (file-name-directory "/home/trevor/.emacs.d/elpa/elfeed-20200910.239/elfeed.elc") 1481 | ;; (backtrace-frame 7) 1482 | ;; (backtrace-get-frames) 1483 | 1484 | ;;; snitch-test.el ends here 1485 | -------------------------------------------------------------------------------- /snitch-timer.el: -------------------------------------------------------------------------------- 1 | ;;; snitch-timer.el --- -*- lexical-binding: t; -*- 2 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3 | ;; 4 | ;; See snitch.el for full details. 5 | ;; 6 | ;; Copyright (C) 2020 Trevor Bentley 7 | ;; Author: Trevor Bentley 8 | ;; URL: https://github.com/mrmekon/snitch-el 9 | ;; 10 | ;; This file is not part of GNU Emacs. 11 | ;; 12 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 13 | ;; 14 | ;;; Commentary: 15 | ;; 16 | ;; This file hooks Emacs timers to save backtrace information. It is 17 | ;; used by the snitch-backtrace functions to reproduce full backtraces 18 | ;; for functions initiated by timers. This is required to provide a 19 | ;; more accurate guess as to which function/package originated a call 20 | ;; intercepted by snitch, since functions started by timers lose their 21 | ;; original backtrace. 22 | ;; 23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 24 | ;; 25 | ;; This program is free software; you can redistribute it and/or modify 26 | ;; it under the terms of the GNU General Public License as published by 27 | ;; the Free Software Foundation; either version 2, or (at your option) 28 | ;; any later version. 29 | ;; 30 | ;; This program is distributed in the hope that it will be useful, 31 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 32 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 33 | ;; GNU General Public License for more details. 34 | ;; 35 | ;; You should have received a copy of the GNU General Public License 36 | ;; along with this program; see the file COPYING. If not, write to 37 | ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth 38 | ;; Floor, Boston, MA 02110-1301, USA. 39 | ;; 40 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 41 | ;; 42 | ;;; Code: 43 | (require 'snitch-custom) 44 | 45 | (declare-function snitch--backtrace "snitch-backtrace.el") 46 | 47 | (defvar snitch--timer-alist '() 48 | "Cache of Emacs timers tracked by snitch. 49 | 50 | Cache all timers registered with Emacs, along with their 51 | backtrace and a timeout. Stored as a list of (TIMER . METADATA) 52 | cons cell entries, where each METADATA item is a (BACKTRACE 53 | . TIMEOUT) cons cell. TIMER is a standard Emacs timer object, 54 | BACKTRACE is a snitch backtrace, and TIMEOUT is a standard Emacs 55 | time object.") 56 | 57 | (defvar snitch--timer-removal-queue '() 58 | "List of Emacs timers to be removed from snitch’s tracking. 59 | 60 | List of timers to be removed from snitch’s backtrace tracking 61 | when the timer call stack is empty. Timers are queued to be 62 | removed instead of removed immediately because of the (likely) 63 | possibility of recursive removals. If the timer is removed deep 64 | in a recursive stack, the outer calls are unable to decorate the 65 | backtraces as the stack unwinds because the timer is already 66 | gone.") 67 | 68 | (defvar snitch--timer-count 0 69 | "Total number of timers snitch has tracked. 70 | 71 | Total number of timers snitch has saved (timers registered with 72 | Emacs and intercepted by snitch).") 73 | 74 | (defvar snitch--timer-removed-count 0 75 | "Total number of timers snitch has finished tracking. 76 | 77 | Total number of timers snitch has removed (timers fired or 78 | cancelled that snitch knew about).") 79 | 80 | (defvar snitch--timer-missed-count 0 81 | "Total number of timers that snitch failed to track. 82 | 83 | Total number of timers snitch has missed. This is timers that 84 | are removed (cancelled or triggered) while not currently tracked 85 | in ‘snitch--timer-alist’. This can happen naturally if snitch is 86 | started when timers already exist, but could also indicate bugs 87 | causing snitch to lose track of timers.") 88 | 89 | (defvar snitch--wrap-timer-depth 0 90 | "Tracks current recursive depth of calls to remove timers. 91 | Timer handlers often attempt to manually remove themselves, 92 | resulting in several calls to remove the same timer.") 93 | 94 | (defvar snitch--max-timer-backtraces 1000 95 | "Max number of timer backtrace snitch tracks at a time. 96 | 97 | Maximum number of timer backtraces that snitch should keep 98 | track of. If more timers than this are started without ending, 99 | new timers are ignored.") 100 | 101 | (defvar snitch--save-unique-timer-fns nil 102 | "Whether snitch saves names of timers tracked. 103 | 104 | While t, snitch saves a list of the unique functions 105 | registered as timers, along with a count of how many times they 106 | were seen. This allows tracking which high-frequency timers are 107 | common in your Emacs, so they can be added to the timer 108 | blacklist.") 109 | 110 | (defvar snitch--unique-timer-fns '() 111 | "List of unique timer functions snitch has tracked. 112 | 113 | A list of unique timer functions encountered, and how many 114 | times they were seen during the period that 115 | ‘snitch--save-unique-timer-fns’ was t.") 116 | 117 | (defun snitch-monitor-unique-timer-fns (&optional time no-reset) 118 | "Print names of timer functions snitch recently tracked. 119 | 120 | Keeps a running count of each unique timer function that arrives 121 | during time period TIME. After TIME has elapsed, prints all 122 | timers seen along with the number of times each was seen during 123 | the monitoring time period. 124 | 125 | Each call to this function resets the seen timer list to empty. 126 | To continue capturing without clearing the list, set NO-RESET to 127 | t." 128 | (interactive) 129 | (unless time (setq time 60)) 130 | (unless no-reset 131 | (setq snitch--unique-timer-fns '())) 132 | (setq snitch--save-unique-timer-fns t) 133 | (run-with-timer 134 | time nil 135 | (lambda () 136 | (setq snitch--save-unique-timer-fns nil) 137 | (message "*** SNITCH -- UNIQUE TIMERS DETECTED IN %d s ***" time) 138 | (cl-loop for (timer . count) in snitch--unique-timer-fns 139 | do (message "%s: %d" timer count))))) 140 | 141 | (defun snitch--timer-test-idle-timeout (time) 142 | "Whether a tracked idle timer has timed out. 143 | 144 | Return t if an idle timer has timed out (current idle time 145 | greater than TIME)." 146 | (let ((idle (current-idle-time))) 147 | (when idle 148 | (time-less-p time idle)))) 149 | 150 | (defun snitch--timer-test-timeout (time) 151 | "Whether a tracked normal timer has timed out. 152 | 153 | Return t if a regular timer has timed out (current absolute time 154 | greater than TIME)." 155 | (time-less-p time (current-time))) 156 | 157 | (defun snitch--timer-timeout (timer) 158 | "Calculate timeout period for a tracked timer. 159 | 160 | Calculate a timeout for a timer, TIMER, a few minutes longer than 161 | it is originally scheduled to fire." 162 | (time-add (timer--time timer) (time-convert (* 60 5)))) 163 | 164 | (defun snitch--fn-repr (fn) 165 | "Output function in human-readable format. 166 | 167 | Encode FN in a semi-human-readable form if it is a compiled 168 | function." 169 | (cond 170 | ((byte-code-function-p fn) 171 | ;; sxhash would be a nice alternative, but it isn't guaranteed 172 | ;; to be consistent across sessions. 173 | ;; 174 | ;; (base64-encode-string (gnutls-hash-digest "SHA1" (aref fn 1))) 175 | ;; (sxhash (aref fn 1)) 176 | (secure-hash 'sha1 (aref fn 1))) 177 | ((and (listp fn) 178 | (or (eq (car fn) 'lambda) 179 | (eq (car fn) 'closure))) 180 | (secure-hash 'sha1 (prin1-to-string fn))) 181 | (t fn))) 182 | 183 | (defun snitch--save-timer-function (fn) 184 | "Save recently tracked timer in cache. 185 | 186 | Save timer function FN in SNITCH--UNIQUE-TIMER-FNS if it does 187 | not already exist, otherwise increment its counter. Byte 188 | compiled functions are stored as a hash, since their names are 189 | unknown." 190 | (let* ((fn-rep (snitch--fn-repr fn)) 191 | (entry (assoc fn-rep snitch--unique-timer-fns))) 192 | (if entry 193 | (setcdr entry (+ (cdr entry) 1)) 194 | (setq snitch--unique-timer-fns 195 | (cons (cons fn-rep 1) snitch--unique-timer-fns))))) 196 | 197 | (defun snitch--save-timer-backtrace (orig-fn &rest args) 198 | "Save timer and its backtrace in snitch’s timer cache. 199 | 200 | Cache a timer and its associated backtrace. This function is 201 | hooked around all functions that register new timers with Emacs. 202 | It saves the backtrace and a timeout period for when snitch 203 | should stop listening for it in case the timer is somehow lost. 204 | It calls the original Emacs timer registration function without 205 | modification and returns the result. 206 | 207 | Always calls the original function ORIG-FN is called with its 208 | arguments ARGS unmodified." 209 | (let* ((bt (snitch--backtrace)) 210 | (timer (nth 0 args)) 211 | (idle (nth 3 args)) 212 | (expire-time (snitch--timer-timeout timer)) 213 | (timeout-fn 214 | (if idle 215 | (lambda () (snitch--timer-test-idle-timeout expire-time)) 216 | (lambda () (snitch--timer-test-timeout expire-time)))) 217 | (result (apply orig-fn args))) 218 | (when snitch--save-unique-timer-fns 219 | (snitch--save-timer-function (timer--function timer))) 220 | (if (>= (length snitch--timer-alist) snitch--max-timer-backtraces) 221 | (when snitch-print-timer-warnings 222 | (message "*snitch warning* too many timers, discarding: %s" 223 | (snitch--fn-repr (timer--function timer)))) 224 | (progn 225 | (setq snitch--timer-alist 226 | (cons (cons timer (cons bt timeout-fn)) snitch--timer-alist)) 227 | (setq snitch--timer-count (+ snitch--timer-count 1)))) 228 | result)) 229 | 230 | (defun snitch--remove-timed-out-timers () 231 | "Remove tracked timers that have timed out. 232 | 233 | Iterate of all of snitch's saved timer backtraces and remove 234 | any that have timed out." 235 | (cl-loop for (timer . (_bt . timeout-fn)) in snitch--timer-alist 236 | when (funcall timeout-fn) 237 | do 238 | (let ((match (assq timer snitch--timer-alist))) 239 | (when match 240 | (when snitch-print-timer-warnings 241 | (message "*snitch warning* timer timed out: %s" 242 | (snitch--fn-repr (timer--function timer)))) 243 | (setq snitch--timer-removed-count 244 | (+ snitch--timer-removed-count 1)) 245 | (setq snitch--timer-alist 246 | (delq match snitch--timer-alist)))))) 247 | 248 | (defun snitch--remove-timers (timers) 249 | "Remove a list of timers from snitch’s tracking. 250 | 251 | Remove all timers in TIMERS from the timer backtrace cache, if 252 | present." 253 | (let ((total-timers (length timers)) 254 | (removed-timers 0)) 255 | (cl-loop 256 | for timer in timers 257 | do (let ((match (assq timer snitch--timer-alist))) 258 | (when (and (null match) 259 | snitch-print-timer-warnings) 260 | (message "*snitch warning* remove unknown timer: %s" 261 | (snitch--fn-repr (timer--function timer))) 262 | (setq snitch--timer-missed-count 263 | (+ snitch--timer-missed-count 1))) 264 | (when match 265 | (setq snitch--timer-removed-count 266 | (+ snitch--timer-removed-count 1)) 267 | (setq removed-timers (1+ removed-timers)) 268 | (setq snitch--timer-alist 269 | (delq match snitch--timer-alist))))) 270 | ;;(message "removed %d of %d timers" removed-timers total-timers) 271 | (list removed-timers total-timers))) 272 | 273 | (defun snitch--remove-timer-backtrace (orig-fn timer) 274 | "Remove a timer from snitch’s tracking cache. 275 | 276 | Remove a timer from snitch’s cache. This function is wrapped 277 | around ‘timer-event-handler’ and ‘cancel-timer’, triggering 278 | whenever a timer either fires or is explicitly cancelled. It 279 | removes snitch’s decorated copy and calls the originally 280 | requested function as normal. 281 | 282 | Always calls the original function ORIG-FN with its original 283 | argument, TIMER." 284 | (setq snitch--wrap-timer-depth (+ snitch--wrap-timer-depth 1)) 285 | (let* ((result (apply orig-fn (list timer)))) 286 | ;; TODO: this is probably wrong. What if one timer removed a 287 | ;; different timer? That would also be at a lower depth. 288 | ;; Disabled depth test for now, but that triggers the ’unknown 289 | ;; timer’ warning all the time, so that is also disabled. 290 | ;; 291 | ;; TODO: reverted back to only removing at top, but need to fix 292 | ;; this. When recursive removals are allowed, it gets removed 293 | ;; from the alist during a deeper cancel-timer call before the 294 | ;; outer logic finishes running and actually triggers the snitch 295 | ;; path that needs the backtrace. We should queue up removals in 296 | ;; a list and remove them all at once when wrap-depth falls to 0. 297 | (add-to-list 'snitch--timer-removal-queue timer) 298 | (setq snitch--wrap-timer-depth 299 | (- snitch--wrap-timer-depth 1)) 300 | ;; as we exit the last removal attempt in the potentially 301 | ;; recursive stack, actually remove the timers from snitch’s cache 302 | ;; and check for any timed out ones 303 | (when (eq snitch--wrap-timer-depth 0) 304 | (snitch--remove-timers snitch--timer-removal-queue) 305 | (setq snitch--timer-removal-queue '()) 306 | (snitch--remove-timed-out-timers)) 307 | result)) 308 | 309 | (defun snitch--get-timer-backtrace (timer) 310 | "Return backtrace for TIMER if it is currently known." 311 | (let ((match (assq timer snitch--timer-alist))) 312 | (when match 313 | (car (cdr match))))) 314 | 315 | (defun snitch--remove-timer-hooks () 316 | "Remove snitch’s timer hooks, disabling timer backtraces." 317 | (remove-function (symbol-function 'timer--activate) 318 | #'snitch--save-timer-backtrace) 319 | (remove-function (symbol-function 'timer-event-handler) 320 | #'snitch--remove-timer-backtrace) 321 | (remove-function (symbol-function 'cancel-timer) 322 | #'snitch--remove-timer-backtrace) 323 | (remove-function (symbol-function 'cancel-timer-internal) 324 | #'snitch--remove-timer-backtrace)) 325 | 326 | (defun snitch--register-timer-hooks () 327 | "Register snitch’s timer tracing hooks. 328 | 329 | Add timer hooks so snitch can provide backtraces all the way 330 | to the source of whichever function registered the timer." 331 | (setq snitch--timer-alist '() 332 | snitch--timer-removal-queue '() 333 | snitch--wrap-timer-depth 0 334 | snitch--timer-count 0 335 | snitch--timer-removed-count 0 336 | snitch--timer-missed-count 0 337 | snitch--unique-timer-fns '()) 338 | (add-function :around (symbol-function 'timer--activate) 339 | #'snitch--save-timer-backtrace) 340 | (add-function :around (symbol-function 'timer-event-handler) 341 | #'snitch--remove-timer-backtrace) 342 | (add-function :around (symbol-function 'cancel-timer) 343 | #'snitch--remove-timer-backtrace) 344 | (add-function :around (symbol-function 'cancel-timer-internal) 345 | #'snitch--remove-timer-backtrace)) 346 | 347 | (defun snitch--debug-print-timer-state (&optional alist) 348 | "Print state of snitch’s timer tracing. 349 | 350 | Print current state of snitch’s timer tracing to the messages 351 | log. If ALIST is t, also prints the currently cached timers." 352 | (interactive) 353 | (message "%s" (current-time-string)) 354 | (message "timer active: %d" (length snitch--timer-alist)) 355 | (message "timer saved: %d" snitch--timer-count) 356 | (message "timer removed: %d" snitch--timer-removed-count) 357 | (message "timer missed: %d" snitch--timer-missed-count) 358 | (when alist 359 | (message "timer alist: %s" snitch--timer-alist) 360 | (cl-loop for (_timer . (_bt . timeout-fn)) in snitch--timer-alist 361 | do (message "timeout? %s" (funcall timeout-fn))))) 362 | 363 | (defun snitch--activate-timer-trace () 364 | "Activate snitch timer tracing. 365 | 366 | Activate snitch timer tracing by hooking the appropriate 367 | functions." 368 | (interactive) 369 | (snitch--register-timer-hooks)) 370 | 371 | (defun snitch--deactivate-timer-trace () 372 | "Deactivate snitch timer tracing." 373 | (interactive) 374 | (snitch--remove-timer-hooks)) 375 | 376 | (defun snitch--debug-test-print-timers () 377 | "Print snitch’s cached timer state. 378 | 379 | Print snitch’s cached timers, and all of Emacs’ currently 380 | registered timers." 381 | (cl-loop for (timer . meta) in snitch--timer-alist 382 | do 383 | (message "timer fn: %s" (timer--function timer))) 384 | (cl-loop for timer in timer-list 385 | do 386 | (message "timer fn: %s" (timer--function timer))) 387 | (cl-loop for timer in timer-idle-list 388 | do 389 | (message "timer fn: %s" (timer--function timer)))) 390 | 391 | 392 | (provide 'snitch-timer) 393 | 394 | ;;; snitch-timer.el ends here 395 | -------------------------------------------------------------------------------- /snitch.el: -------------------------------------------------------------------------------- 1 | ;;; snitch.el --- An Emacs firewall -*- lexical-binding: t; -*- 2 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3 | ;; 4 | ;; Copyright (C) 2020 Trevor Bentley 5 | ;; Author: Trevor Bentley 6 | ;; Created: 01 Dec 2020 7 | ;; Version: 0.3.1 8 | ;; Package-Requires: ((emacs "27.1")) 9 | ;; 10 | ;; Keywords: processes, comm 11 | ;; URL: https://github.com/mrmekon/snitch-el 12 | ;; 13 | ;; This file is not part of GNU Emacs. 14 | ;; 15 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 16 | ;; 17 | ;;; Commentary: 18 | ;; 19 | ;; snitch.el (pronounced like schnitzel) is a firewall for Emacs. 20 | ;; 21 | ;; snitch intercepts calls to create network connections or launch 22 | ;; subprocesses. Through user-configured default policies, filter 23 | ;; rules, and user hooks it is able to log and potentially block each 24 | ;; action. It can be configured with ‘M-x customize-group 25 | ;; snitch’. 26 | ;; 27 | ;; Subprocesses and network connections are handled independently, 28 | ;; with their own separate default policies, blacklist and whitelist, 29 | ;; and logging policies. 30 | ;; 31 | ;; The main purpose of snitch is network monitoring. Subprocesses are 32 | ;; included because it is extremely common for Emacs packages to 33 | ;; "shell out" to an external program for network access, commonly to 34 | ;; ‘curl’. As a side effect, snitch can also effectively audit and 35 | ;; prevent undesired access to other programs. 36 | ;; 37 | ;; Notifications can be raised on each logged event by ensuring the 38 | ;; ’alert’ package is installed and customizing 39 | ;; ‘snitch-enable-notifications’ to t. 40 | ;; 41 | ;; 42 | ;; === WHY? === 43 | ;; 44 | ;; Emacs is a general-purpose execution environment, executing with 45 | ;; the full privileges of whichever user launched it. It can read and 46 | ;; create files, obviously, but also spawn external programs, open 47 | ;; network connections, and communicate through pipes. In modern 48 | ;; times, most users manage large collections of third-party packages 49 | ;; through intelligent package managers that automatically pull in any 50 | ;; number of dependencies, updated periodically. Any and all of these 51 | ;; could be a bit naughty, and the sheer quantity of Lisp code in a 52 | ;; modern Emacs install makes it un-auditable. 53 | ;; 54 | ;; An Emacs firewall, thus, makes sense. Does *snitch* make sense? 55 | ;; Not really... see the SECURITY section below. But we currently 56 | ;; have nothing, and snitch is better than nothing. 57 | ;; 58 | ;; Also, to answer the question: "I wonder if I can make an Emacs 59 | ;; firewall?" Yes! ...well, sort of. 60 | ;; 61 | ;; 62 | ;; === MECHANISM === 63 | ;; 64 | ;; The underlying ’firewall’ mechanism is built on function advice 65 | ;; surrounding Emacs’s lowest-level core functions for spawning 66 | ;; connections or subprocesses. When an Emacs package or script makes 67 | ;; such a request, snitch receives it first, and either passes it 68 | ;; through or rejects it based on the current rules. Once a 69 | ;; connection or process is accepted, snitch is no longer involved for 70 | ;; the duration of that particular communication stream. 71 | ;; 72 | ;; For each intercepted call, snitch first builds an event object 73 | ;; defining everything snitch knows about the call. The metadata 74 | ;; differs for network connections (host, port, family) and processes 75 | ;; (executable and argument list), but all events share a common set: 76 | ;; calling function, calling function’s file path, calling package, 77 | ;; and request name. 78 | ;; 79 | ;; Once an event object is created, it is passed to any hooks defined 80 | ;; in ‘snitch-on-event-functions’ for early processing. If a hook 81 | ;; returns nil, the event is dropped immediately. Otherwise, snitch 82 | ;; then checks the corresponding whitelist (if the default policy is 83 | ;; deny) or the blacklist (if the default policy is allow) and makes 84 | ;; its internal decision. Before executing the decision, it calls the 85 | ;; corresponding hook functions to give the user hooks one more 86 | ;; opportunity to change the decision. Finally, only if the decision 87 | ;; was ‘allow’, snitch executes the original request and passes the 88 | ;; result back to the caller. 89 | ;; 90 | ;; As the event flows through the decision tree, it also triggers log 91 | ;; events. There are several different types defined in 92 | ;; ‘snitch-log-policies’, and users can subscribe to any combination 93 | ;; of them by customizing ‘snitch-log-policy’. Logs are displayed in 94 | ;; text format in a dedicated log buffer (by default: ‘*snitch 95 | ;; firewall log*’), along with text properties that allow extracting 96 | ;; the event information programatically from a log line with 97 | ;; ‘get-text-property’. The text lines can be "pretty printed" by 98 | ;; customizing ‘snitch-log-verbose’. 99 | ;; 100 | ;; An example log entry is below, split to several lines for display. 101 | ;; In the actual log, non-verbose logs are a single line. 102 | ;; 103 | ;; > [2020-12-03 00:16:50] (whitelisted) -- #s(snitch-network-entry \ 104 | ;; > 1606951010.2966838 helm-M-x-execute-command \ 105 | ;; > /home/trevor/.emacs.d/elpa/helm-20201019.715/helm-command.el \ 106 | ;; > helm 127.0.0.1 127.0.0.1 64222 nil) 107 | ;; 108 | ;; With `snitch-log-verbose' enabled, log entries actually do take 109 | ;; several lines: 110 | ;; 111 | ;; > [2020-12-03 01:11:27] (blocked) -- 112 | ;; > (snitch-network-entry "snitch-network-entry-157d34506664" 113 | ;; > 114 | ;; > :timestamp 1606954287.770638 115 | ;; > :src-fn snitch--wrap-make-network-process 116 | ;; > :src-path "/home/trevor/.emacs.d/snitch/snitch.el" 117 | ;; > :src-pkg user 118 | ;; > :proc-name "google.com" 119 | ;; > :host "google.com" 120 | ;; > :port 80) 121 | ;; 122 | ;; 123 | ;; === GETTING SNITCH === 124 | ;; 125 | ;; snitch is published in the MELPA package repository. The recommend 126 | ;; installation method is via an Emacs package manager that supports 127 | ;; MELPA. 128 | ;; 129 | ;; use-package: 130 | ;; 131 | ;; > (use-package snitch :ensure t) 132 | ;; 133 | ;; straight.el: 134 | ;; 135 | ;; > (straight-use-package 'snitch) 136 | ;; 137 | ;; manually: 138 | ;; 139 | ;; > (require 'package) 140 | ;; > (add-to-list 'package-archives 141 | ;; > '("melpa" . "https://melpa.org/packages/")) 142 | ;; > (unless (package-installed-p 'snitch) 143 | ;; > (package-install 'snitch)) 144 | ;; > (require 'snitch) 145 | ;; 146 | ;; 147 | ;; It can also be installed by any package manager that supports git 148 | ;; repositories, or manually via tarball. 149 | ;; 150 | ;; quelpa: 151 | ;; 152 | ;; > (quelpa '(snitch :repo "mrmekon/snitch-el" :fetcher github)) 153 | ;; 154 | ;; use-package + quelpa + quelpa-use-package: 155 | ;; 156 | ;; > (use-package snitch 157 | ;; > :quelpa (snitch :repo "mrmekon/snitch-el" :fetcher github)) 158 | ;; 159 | ;; el-get: 160 | ;; 161 | ;; > (el-get-bundle mrmekon/snitch-el) 162 | ;; 163 | ;; straight.el: 164 | ;; 165 | ;; > (straight-use-package 166 | ;; > '(snitch :type git :host github :repo "mrmekon/snitch-el")) 167 | ;; 168 | ;; manual: 169 | ;; 170 | ;; > (package-install-file "/path/to/snitch-x.y.z.tar") 171 | ;; 172 | ;; 173 | ;; === USAGE === 174 | ;; 175 | ;; Enabling snitch is as simple as calling ‘snitch-mode’ 176 | ;; interactively, or ‘(snitch-mode +1)’ from your init file. 177 | ;; Initialization does very little, so this is safe to call in your 178 | ;; Emacs init without worrying about deferral or negative consequences 179 | ;; on startup time. 180 | ;; 181 | ;; The minimum required initialization is simply: 182 | ;; 183 | ;; > (require 'snitch) 184 | ;; > (snitch-mode +1) 185 | ;; 186 | ;; An example initialization using ‘use-package’ might look like so: 187 | ;; 188 | ;; > (use-package snitch 189 | ;; > :config 190 | ;; > (snitch-mode +1)) 191 | ;; 192 | ;; snitch then runs in the background, performing its duties according 193 | ;; to your configuration, and logging in its dedicated buffer. 194 | ;; 195 | ;; You may add firewall exception rules manually, as covered in the 196 | ;; CONFIGURATION section below. Alternatively, you can also build 197 | ;; filters with a guided UI by switching to the firewall log buffer 198 | ;; (‘*snitch firewall log*’), highlighting an entry that you wish to 199 | ;; filter on, and execute ‘M-x snitch-filter-from-log’. This launches 200 | ;; a popup window that allows you to configure a new filter based on 201 | ;; one or more fields of the selected log line, and add it to either 202 | ;; your blacklist or whitelist. 203 | ;; 204 | ;; To disable snitch, call ‘snitch-mode’ interactively, or 205 | ;; ‘(snitch-mode -1)’ programmatically. You can restart snitch with 206 | ;; ‘snitch-restart’. 207 | ;; 208 | ;; 209 | ;; === CONFIGURATION === 210 | ;; 211 | ;; Customize snitch with ‘M-x customize-group snitch’, or 212 | ;; manually in your Emacs initialization file. 213 | ;; 214 | ;; Most users will have five variables that need to be configured 215 | ;; before use: 216 | ;; 217 | ;; - ‘snitch-network-policy’ -- whether to allow or deny network 218 | ;; connections by default. 219 | ;; 220 | ;; - ‘snitch-process-policy’ -- whether to allow or deny subprocesses 221 | ;; by default. 222 | ;; 223 | ;; - ‘snitch-log-policy’ -- which events to log (to see the options, 224 | ;; run ‘M-x describe-variable snitch-log-policies’) 225 | ;; 226 | ;; - ‘snitch-network-*list’ -- filter rules containing exceptions to 227 | ;; the default network policy. See FILTER RULES below. Use 228 | ;; ‘-whitelist’ if the default policy is ‘deny’, or ‘-blacklist’ if 229 | ;; the default policy is ‘allow’ 230 | ;; 231 | ;; - ‘snitch-process-*list’ -- filter rules containing exceptions to 232 | ;; the default process policy. See FILTER RULES below. Use 233 | ;; ‘-whitelist’ if the default policy is ‘deny’, or ‘-blacklist’ if 234 | ;; the default policy is ‘allow’ 235 | ;; 236 | ;; 237 | ;; Have a look in ‘snitch-filter.el’ for examples of black/whitelist 238 | ;; filters, and in ‘snitch-test.el’ for contrived examples of pretty 239 | ;; much everything. 240 | ;; 241 | ;; 242 | ;; ==== COMMON CONFIG: DENY ==== 243 | ;; 244 | ;; A useful configuration is to deny all external communication by 245 | ;; default, but allow certain packages to communicate. This example 246 | ;; demonstrates permitting only the ’elfeed’ package to create network 247 | ;; connections: 248 | ;; 249 | ;; > (use-package snitch 250 | ;; > :config 251 | ;; > (setq snitch-network-policy 'deny) 252 | ;; > (setq snitch-process-policy 'deny) 253 | ;; > (setq snitch-log-policy '(blocked whitelisted allowed)) 254 | ;; > (add-to-list 'snitch-network-whitelist 255 | ;; > (cons #'snitch-filter-src-pkg '(elfeed))) 256 | ;; > (snitch-mode +1)) 257 | ;; 258 | ;; 259 | ;; ==== COMMON CONFIG: ALLOW + AUDIT ==== 260 | ;; 261 | ;; Another useful configuration is to allow all accesses, but log them 262 | ;; to keep an audit trail. This might look like so: 263 | ;; 264 | ;; > (use-package snitch 265 | ;; > :config 266 | ;; > (setq snitch-network-policy 'allow) 267 | ;; > (setq snitch-process-policy 'allow) 268 | ;; > (setq snitch-log-policy '(allowed blocked whitelisted blacklisted)) 269 | ;; > (setq snitch-log-verbose t) 270 | ;; > (snitch-mode +1)) 271 | ;; 272 | ;; 273 | ;; ==== FILTER RULES ==== 274 | ;; 275 | ;; Filter rules, as specified in ‘snitch-(process|network)-*list’ 276 | ;; variables, are specified as cons cells where the car is a filtering 277 | ;; function, and the cdr is a list of arguments to pass to the 278 | ;; function in addition to the event object: 279 | ;; 280 | ;; > (setq snitch-network-whitelist 281 | ;; > '( 282 | ;; > (filter-fn1 . (argQ)) 283 | ;; > (filter-fn2 . (argN argP)) 284 | ;; > )) 285 | ;; 286 | ;; Each filter function should have a prototype accepting EVENT as the 287 | ;; snitch event object in consideration, and ARGS as the list of 288 | ;; arguments from the cdr of the rules entry: 289 | ;; 290 | ;; > (defun filter-fn1 (event &rest args)) 291 | ;; 292 | ;; EVENT is an eieio object defined by ‘snitch-network-entry’ or 293 | ;; ‘snitch-process-entry’, and inheriting from ‘snitch-source’. 294 | ;; 295 | ;; A trivial function which matches if a single string in the event 296 | ;; object matches a known value might look like so: 297 | ;; 298 | ;; > (defun filter-fn1 (event name) 299 | ;; > (string-equal (oref event proc-name) name)) 300 | ;; 301 | ;; While a more complex filter function might treat ARGS as an 302 | ;; associative list of key/value pairs: 303 | ;; 304 | ;; > (defun filter-fn2 (event &rest alist) 305 | ;; > (cl-loop for (aslot . avalue) in alist with accept = t 306 | ;; > do 307 | ;; > (let ((evalue (eieio-oref event aslot)) 308 | ;; > (val-type (type-of avalue))) 309 | ;; > (unless (cond 310 | ;; > ((eq val-type 'string) (string-equal avalue evalue)) 311 | ;; > (t (eq avalue evalue))) 312 | ;; > (setq accept nil))) 313 | ;; > when (null accept) 314 | ;; > return nil 315 | ;; > finally return accept)) 316 | ;; 317 | ;; The return value of a filter function determines whether the filter 318 | ;; should take effect. t means "take effect" and nil means "do not 319 | ;; take effect". What that means for the event depends on which list 320 | ;; the filter rule is in. If the rule is in a whitelist, t means 321 | ;; allow and nil means block. If it is in a blacklist, t means block 322 | ;; and nil means allow. 323 | ;; 324 | ;; 325 | ;; ==== HOOKS ==== 326 | ;; 327 | ;; Events are passed to user-provided hook functions, if specified. 328 | ;; These hooks can subscribe to receive events either immediately on 329 | ;; arrival, upon a final decision, or both. The hooks can change 330 | ;; snitch’s final decision. 331 | ;; 332 | ;; Hook functions take two arguments, the type and the event object: 333 | ;; 334 | ;; > (defun snitch-hook (type event)) 335 | ;; 336 | ;; TYPE is one of `snitch-hook-types', and corresponds with the names 337 | ;; of the hook lists. This argument is provided so you can define one 338 | ;; function which can be used in several hooks. 339 | ;; 340 | ;; EVENT is an eieio object defined by ‘snitch-network-entry’ or 341 | ;; ‘snitch-process-entry’, and inheriting from ‘snitch-source’. 342 | ;; 343 | ;; Hooks should return t to allow snitch to continue processing as it 344 | ;; would have, or return nil to reverse snitch’s decision. For hooks 345 | ;; in ‘snitch-on-event-functions’, returning nil cancels all further 346 | ;; processing of the event and blocks it immediately. For other hook 347 | ;; lists, returning nil reverses the action implied by the list name: 348 | ;; returning nil in a ‘snitch-on-allow-functions’ hook causes the 349 | ;; event to be blocked, returning nil in a ‘snitch-on-block-functions’ 350 | ;; hook causes it to be allowed. 351 | ;; 352 | ;; 353 | ;; snitch also supports filtering log entries with hooks via 354 | ;; ‘snitch-log-functions’. These hooks can pass, block, or modify 355 | ;; entries before they are printed in the snitch log. See ‘M-x 356 | ;; describe-variable snitch-log-functions’ for details. 357 | ;; 358 | ;; snitch also calls hooks when it starts (‘snitch-init-hook’), shuts 359 | ;; down (‘snitch-deinit-hook’), or opens or closes the log filter 360 | ;; window (‘snitch-log-filter-window-open-hook’, 361 | ;; ‘snitch-log-filter-window-close-hook’). 362 | ;; 363 | ;; 364 | ;; === PERFORMANCE === 365 | ;; 366 | ;; Performance has not been measured, and should not be assumed to be 367 | ;; particularly good. Nothing is currently optimized. 368 | ;; 369 | ;; Memory usage should not be particularly high, as events are 370 | ;; ephemeral and only contain a small amount of metadata. The largest 371 | ;; use of memory is the audit log, which does keep copies of all 372 | ;; events in the log. This can be controlled via 373 | ;; ‘snitch-log-buffer-max-lines’. 374 | ;; 375 | ;; Firewall rules are traversed linearly, and short-circuit (if an 376 | ;; early rule terminates processing, the subsequent rules will not be 377 | ;; considered). To optimize for performance, the total number of 378 | ;; rules should be kept to a minimum, and most likely to match rules 379 | ;; should be added earlier in the lists. 380 | ;; 381 | ;; 382 | ;; === TIMER TRACING === 383 | ;; 384 | ;; Since snitch’s usefulness is highly dependent on the ability to 385 | ;; trace back to the original source that triggered an event, Emacs 386 | ;; timers pose a bit of a challenge. Timers are used to trigger 387 | ;; network requests asynchronously, but have the side effect of losing 388 | ;; the stack trace back to the function or package that initiated it. 389 | ;; 390 | ;; To deal with this, snitch optionally supports timer tracing. When 391 | ;; tracing is enabled, by customizing ‘snitch-trace-timers’ to t, 392 | ;; snitch hooks into Emacs’s timer functions, and records backtraces 393 | ;; whenever a timer is registered. If a timer later generates a 394 | ;; snitch-relevant event, snitch concatenates the regular backtrace 395 | ;; with the cached timer backtrace to get a full call stack for the 396 | ;; event. 397 | ;; 398 | ;; As an example, here are two snitch log entries when opening RSS 399 | ;; feeds with the elfeed package, which uses timers for web requests: 400 | ;; 401 | ;; With ‘snitch-trace-timers’ set to nil (tracing disabled): 402 | ;; 403 | ;; > [2020-12-07 21:32:56] (allowed) -- #s(snitch-network-entry \ 404 | ;; > 1607373176.6757963 \ 405 | ;; > timer-event-handler \ 406 | ;; > /usr/share/emacs/27.1/lisp/emacs-lisp/timer.el \ 407 | ;; > site-lisp \ 408 | ;; > www.smbc-comics.com www.smbc-comics.com 443 nil) 409 | ;; 410 | ;; Notice how the source is the function ‘timer-event-handler’ in 411 | ;; ‘timer.el’, part of the special ‘site-lisp’ package? *All* 412 | ;; timer-originated network calls appear to originate from that 413 | ;; function, since it is the lowest level Emacs timer dispatch 414 | ;; function. It is impossible to filter on the true source. 415 | ;; 416 | ;; Now with ‘snitch-trace-timers’ set to t (tracing enabled): 417 | ;; 418 | ;; > [2020-12-07 21:33:06] (allowed) -- #s(snitch-network-entry \ 419 | ;; > 1607373186.6863618 \ 420 | ;; > elfeed-insert-html 421 | ;; > /home/trevor/.emacs.d/elpa/elfeed-20200910.239/elfeed-show.el \ 422 | ;; > elfeed \ 423 | ;; > www.smbc-comics.com www.smbc-comics.com 443 nil) 424 | ;; 425 | ;; For this event, snitch has successfully traced through the timer to 426 | ;; find the true source, ‘elfeed-insert-html’ in the ‘elfeed’ package! 427 | ;; 428 | ;; Timer tracing comes with a cost: snitch has to generate metadata 429 | ;; for every single timer event. If your Emacs usage involves a very 430 | ;; large number of timers, or very high-frequency timers, snitch’s 431 | ;; tracing could lead to delays and inflated memory usage. Consider 432 | ;; carefully whether this is a feature you need, and leave it disabled 433 | ;; if you will not use it, or if you experience any performance issues 434 | ;; while running snitch. 435 | ;; 436 | ;; You can run ‘snitch-monitor-unique-timer-fns’ to get a sense of 437 | ;; which timers are currently active. After running that function, 438 | ;; there will be a 60 second delay, followed by printing the names of 439 | ;; all timers that were active during the minute and the number of 440 | ;; times they fired. 441 | ;; 442 | ;; Similarly, if you run with timer tracing enabled for a while, you 443 | ;; can use ‘snitch--debug-print-timer-state’ to print a summary of how 444 | ;; many timers snitch has intercepted, and how many saved backtraces 445 | ;; are currently active in memory. 446 | ;; 447 | ;; 448 | ;; === SECURITY === 449 | ;; 450 | ;; snitch provides, effectively, zero security. 451 | ;; 452 | ;; If you were to ask your Principal Security Engineer friends, they 453 | ;; might say that an effective security boundary must be 454 | ;; "tamper-proof" and provide "complete mediation." snitch does 455 | ;; neither. 456 | ;; 457 | ;; Tamper-proof: none at all. Any other Emacs package can simply 458 | ;; disable snitch, or modify it to pass malicious traffic undetected. 459 | ;; 460 | ;; Complete mediation: no attempt has been made to verify that *all* 461 | ;; network and subprocess accesses must go through the functions that 462 | ;; snitch hooks. Given the complexity of Emacs, it is extremely 463 | ;; unlikely that they do. 464 | ;; 465 | ;; However, your Principal Security Engineer friends also like to 466 | ;; blather on about ’defining your security model’, and a fun game to 467 | ;; play with them is to define your security model such that none of 468 | ;; the insecurities are in it. As so: 469 | ;; 470 | ;; Security model: includes malicious adversaries 471 | ;; snitch effectiveness: zero. 472 | ;; 473 | ;; Security model: includes no malicious adversaries 474 | ;; snitch effectiveness: great! 475 | ;; 476 | ;; snitch is useful for auditing and blocking unwanted features in an 477 | ;; otherwise well-behaving ecosystem. It is handy for getting a 478 | ;; record of exactly what your Emacs is doing, and for fine-tuning 479 | ;; accesses beyond Emacs’s boundaries a little bit better. It will 480 | ;; not, however, save you from the bad guys. 481 | ;; 482 | ;; 483 | ;; === KNOWN LIMITATIONS === 484 | ;; 485 | ;; When snitch blocks events, some Emacs functions that seldom throw 486 | ;; errors in normal use will throw errors because of snitch. It is 487 | ;; very likely that blocked connections will cause errors to bubble up 488 | ;; in strange and unexpected ways, as many package authors have not 489 | ;; handled these exceptional cases. 490 | ;; 491 | ;; snitch does not intercept domain name resolution (DNS). 492 | ;; 493 | ;; snitch has a strong preference for identifying user-provided 494 | ;; packages as the "originating source" of events. Events that you 495 | ;; may consider as originated in built-in/site-lisp code may be 496 | ;; attributed to a user package instead, if one is higher up in the 497 | ;; backtrace. For instance, `helm' may often show up as the source if 498 | ;; installed, since `helm-M-x-execute-command' is often somewhere in 499 | ;; the stack. 500 | ;; 501 | ;; snitch has not been tested with IPv6. 502 | ;; 503 | ;; snitch has not been tested with inbound connections. In theory, it 504 | ;; can prevent the creation of a listening socket. Once a socket is 505 | ;; open, though, it would not be able to monitor incoming connections 506 | ;; to the socket. 507 | ;; 508 | ;; 509 | ;; === TODO === 510 | ;; 511 | ;; - send notifications in batches? 512 | ;; - interactive prompts? 513 | ;; - handle service strings as port numbers 514 | ;; - ensure the inverted negation rules make sense 515 | ;; - add blacklist for timer functions 516 | ;; - profit! 517 | ;; 518 | ;; 519 | ;; === VERSION HISTORY === 520 | ;; 521 | ;; v0.3.1 (development) 522 | ;; 523 | ;; v0.3.0 (2021-02-02) 524 | ;; 525 | ;; - published on MELPA 526 | ;; - make snitch a global minor mode 527 | ;; - introduce (snitch-mode) 528 | ;; - make (snitch-init) private (snitch--init) 529 | ;; - make (snitch-deinit) private (snitch--deinit) 530 | ;; - add init and deinit hooks 531 | ;; - customizable keymap for log filter wizard 532 | ;; - fixed several byte compiler warnings 533 | ;; 534 | ;; v0.2.0 (2020-12-09) 535 | ;; 536 | ;; - first published version 537 | ;; 538 | ;; v0.1.0 (before 2020-12-09) 539 | ;; 540 | ;; - Initial development and testing 541 | ;; - Network and process firewall functionality 542 | ;; - Audit logging 543 | ;; - Whitelist + blacklist filtering 544 | ;; - Backtrace processing 545 | ;; - Timer backtrace expansion 546 | ;; - User event and logging hooks 547 | ;; - ert test framework 548 | ;; 549 | ;; 550 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 551 | ;; 552 | ;; This program is free software; you can redistribute it and/or modify 553 | ;; it under the terms of the GNU General Public License as published by 554 | ;; the Free Software Foundation; either version 2, or (at your option) 555 | ;; any later version. 556 | ;; 557 | ;; This program is distributed in the hope that it will be useful, 558 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 559 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 560 | ;; GNU General Public License for more details. 561 | ;; 562 | ;; You should have received a copy of the GNU General Public License 563 | ;; along with this program; see the file COPYING. If not, write to 564 | ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth 565 | ;; Floor, Boston, MA 02110-1301, USA. 566 | ;; 567 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 568 | ;; 569 | ;;; Code: 570 | 571 | (require 'eieio) ; class objects 572 | (require 'cl-lib) ; cl loops 573 | (require 'package) ; backtrace package sources 574 | (require 'backtrace) 575 | 576 | (require 'snitch-backtrace) 577 | (require 'snitch-custom) 578 | (require 'snitch-filter) 579 | (require 'snitch-timer) 580 | (require 'snitch-log) 581 | 582 | ;; 583 | ;; 584 | ;; Classes 585 | ;; 586 | ;; 587 | 588 | ;;;###autoload 589 | (defclass snitch-source () 590 | ((timestamp :initarg :timestamp :type number :initform 0) 591 | (src-fn :initarg :src-fn :type (or null symbol) :initform nil) 592 | (src-path :initarg :src-path :type (or null string) :initform nil) 593 | (src-pkg :initarg :src-pkg :type (or null symbol) :initform nil)) 594 | "Common base class for snitch entries. Supplies information 595 | about snitch's best guess for which emacs function/file/package 596 | is ultimately responsible for the event that snitch is 597 | considering.") 598 | 599 | ;;;###autoload 600 | (defclass snitch-process-entry (snitch-source) 601 | ((proc-name :initarg :proc-name :type (or null string) :initform nil) 602 | (executable :initarg :executable :type (or null string) :initform nil) 603 | (args :initarg :args :type list :initform ())) 604 | "snitch entry for events attempting to spawn a 605 | subprocess. Supplies information about the name, executable 606 | binary, and arguments being provided to the subprocess that 607 | snitch is considering.") 608 | 609 | ;;;###autoload 610 | (defclass snitch-network-entry (snitch-source) 611 | ((proc-name :initarg :proc-name :type (or null string) :initform nil) 612 | (host :initarg :host :type (or null string symbol) :initform nil) 613 | (port :initarg :port :type (or null number symbol) :initform nil) 614 | (family :initarg :family :type (or null symbol) :initform nil)) 615 | "snitch entry for events attempting to create a network 616 | connection. Supplies information about the name, host, port, and 617 | protocol family of the connection that snitch is considering.") 618 | 619 | 620 | ;; 621 | ;; 622 | ;; Constants 623 | ;; 624 | ;; 625 | 626 | (defconst snitch--version "0.3.1" 627 | "Snitch version as a string.") 628 | 629 | (defconst snitch-source-package-types 630 | '(built-in site-lisp user) 631 | "Possible types for a snitch event's package source. 632 | 633 | Types are specified in the ‘src-pkg’ field of each event object. 634 | 635 | In addition to these pre-defined types, any loaded package 636 | name (as a symbol) is a permitted type as well. 637 | 638 | nil -- unknown source, including lambdas, closures, and 639 | compiled functions. 640 | 641 | 'built-in' -- package provided by Emacs, and responds true to 642 | the ‘package-built-in-p’ function. 643 | 644 | 'site-lisp' -- package is found in one of the Emacs common 645 | directories (i.e. a system-wide shared elisp directory), but does 646 | not report itself as a built-in. 647 | 648 | 'user' -- a package from an unknown source, possibly manually 649 | installed by the user. 650 | 651 | anything else -- a package registered in ‘package--alist’, 652 | typically including those installed by package managers.") 653 | 654 | (defconst snitch-hook-types 655 | '(event block allow whitelist blacklist) 656 | "Types provided to user-defined hooks registered with snitch. 657 | 658 | The types match with the hook callbacks that can receive 659 | them (i.e. ‘snitch-on-event-functions’), but are also provided as 660 | arguments so the same function can be used for multiple hook 661 | types. 662 | 663 | 'event' -- any event type 664 | 665 | 'block' -- log events that are blocked by policy 666 | 667 | 'allow' -- log events that are permitted by policy 668 | 669 | 'whitelist' -- log events that would have been blocked, but 670 | were permitted by a whitelist rule 671 | 672 | 'blacklist' -- log events that would have been allowed, but 673 | were blocked by a blacklist rule") 674 | 675 | (defconst snitch-log-policies 676 | '( 677 | ;; log absolutely everything 678 | all 679 | 680 | ;; log actions for both subprocesses and networks 681 | blocked 682 | allowed 683 | whitelisted 684 | blacklisted 685 | 686 | ;; log actions for only subprocesses 687 | process-blocked 688 | process-allowed 689 | process-whitelisted 690 | process-blacklisted 691 | 692 | ;; log actions for only network connections 693 | network-blocked 694 | network-allowed 695 | network-whitelisted 696 | network-blacklisted) 697 | "Permitted logging policies for snitch. 698 | 699 | Provide a list of these symbols to ‘snitch-log-policy’ to enable 700 | logging of events of the corresponding type. Any combination can 701 | be combined, or use ‘all’ to include everything. 702 | 703 | 'all' -- logs every event, before a decision is made. 704 | 705 | 'blocked' -- log events that are blocked by policy 706 | 707 | 'allowed' -- log events that are permitted by policy 708 | 709 | 'whitelisted' -- log events that would have been blocked, but 710 | were permitted by a whitelist rule 711 | 712 | 'blacklisted' -- log events that would have been allowed, but 713 | were blocked by a blacklist rule 714 | 715 | 'process-*' -- only log subprocess events of the matching type 716 | 717 | 'network-*' -- only log network connection events of the 718 | matching type") 719 | 720 | (defconst snitch-firewall-policies 721 | '(deny allow) 722 | "Default firewall policies. 723 | 724 | 'allow' -- allow all processes/connections unless overridden by 725 | a blacklist rule or registered hook. 726 | 727 | 'deny' -- deny all processes/connections unless overridden by a 728 | whitelist rule or registered hook.") 729 | 730 | 731 | ;; 732 | ;; 733 | ;; Internal functions 734 | ;; 735 | ;; 736 | 737 | (defun snitch--service-to-port (service) 738 | "Convert SERVICE into a symbol or number. 739 | 740 | SERVICE is the service field passed to ‘make-network-process’, 741 | representing the port to connect to." 742 | (cond 743 | ((symbolp service) service) 744 | ;; TODO: handle special service names, ex: "https" 745 | ((stringp service) (string-to-number service)) 746 | ((numberp service) service) 747 | (t (progn 748 | (message "ERROR: unknown network service: %s" service) 749 | nil)))) 750 | 751 | (defun snitch--decide (event 752 | decision-list 753 | list-evt-type 754 | list-hook-fns 755 | default-evt-type 756 | default-hook-fns) 757 | "Decide whether an event should use the default action. 758 | 759 | Return t if EVENT is to be filtered differently from the default 760 | policy, nil if default action is to be taken. The choice of 761 | DECISION-LIST (whitelist or blacklist) and the event types 762 | \(LIST-EVT-TYPE and DEFAULT-EVT-TYPE) determines whether default 763 | is block/allow. Registered user hooks are called, and 764 | potentially alter the decision: LIST-HOOK-FNS if the function was 765 | in the list, or DEFAULT-HOOK-FNS if it was not. 766 | 767 | This function only generates a decision. It does not perform the 768 | actual block or pass action. 769 | 770 | Example: if DEFAULT-EVT-TYPE is ‘block’ and DECISION-LIST is 771 | ‘snitch-network-whitelist’, this function will check each entry 772 | in the network whitelist for an exception. If no exception is 773 | found, it will call the user hooks in 774 | ‘snitch-on-block-functions’. If one of those hooks returns nil, 775 | ‘snitch--decide’ returns t, indicating that the user hook has 776 | changed the default behavior for this event (it should allow 777 | instead of block). On the other hand, if every user hook returns 778 | t, ‘snitch--decide’ returns nil, indicating that the default 779 | block action should be taken." 780 | (cl-loop for (f-fn . f-args) in decision-list 781 | ;; when event is in the white/blacklist, and no 782 | ;; hooks override the list, return t. 783 | when (apply f-fn (cons event f-args)) 784 | return (run-hook-with-args-until-failure list-hook-fns 785 | list-evt-type 786 | event) 787 | ;; otherwise fall back on default policy 788 | finally return 789 | (if (run-hook-with-args-until-failure default-hook-fns 790 | default-evt-type 791 | event) 792 | nil 793 | t))) 794 | 795 | (defun snitch--wrap-internal (event prefix orig-fun args) 796 | "Perform snitch’s core firewall decision. 797 | 798 | Execute the wrapped function, ORIG-FUN with its original 799 | arguments ARGS if EVENT is allowed by default policy or 800 | whitelist. PREFIX is the string 'process' or 'network' to 801 | indicate the type of event. Registered hooks are called before 802 | making the final decision, and the decision is logged based on 803 | the globally configured log filters." 804 | (when (run-hook-with-args-until-failure 'snitch-on-event-functions 805 | 'event 806 | event) 807 | (snitch--log 'all event) 808 | (let* ((policy (symbol-value (intern-soft 809 | (format "snitch-%s-policy" prefix)))) 810 | (wl (symbol-value (intern-soft 811 | (format "snitch-%s-whitelist" prefix)))) 812 | (bl (symbol-value (intern-soft 813 | (format "snitch-%s-blacklist" prefix)))) 814 | (wled (intern-soft (format "%s-whitelisted" prefix))) 815 | (bled (intern-soft (format "%s-blacklisted" prefix))) 816 | (alw (intern-soft (format "%s-allowed" prefix))) 817 | (blk (intern-soft (format "%s-blocked" prefix))) 818 | (decision (cond ((eq policy 'deny) 819 | (snitch--decide event 820 | wl 821 | 'whitelist 822 | 'snitch-on-whitelist-functions 823 | 'block 824 | 'snitch-on-block-functions)) 825 | (t ;; policy allow 826 | (snitch--decide event 827 | bl 828 | 'blacklist 829 | 'snitch-on-blacklist-functions 830 | 'allow 831 | 'snitch-on-allow-functions))))) 832 | (cond ((eq policy 'deny) 833 | (progn 834 | (snitch--log (if decision wled blk) event) 835 | (when decision (apply orig-fun args)))) 836 | (t ;; policy allow 837 | (progn 838 | (snitch--log (if decision bled alw) event) 839 | (unless decision (apply orig-fun args)))))))) 840 | 841 | 842 | (defun snitch--wrap-make-process (orig-fun &rest args) 843 | "Wrap subprocesses with snitch firewall. 844 | 845 | Wrap a call to ‘make-process’ in the snitch firewall decision 846 | engine. ORIG-FUN is called only if the snitch firewall rules 847 | permit it, receiving its default arguments ARGS." 848 | (let* ((bt (snitch--backtrace t)) 849 | (caller (snitch--responsible-caller bt)) 850 | (event (snitch-process-entry 851 | :timestamp (time-to-seconds (current-time)) 852 | :src-fn (nth 0 caller) 853 | :src-path (nth 1 caller) 854 | :src-pkg (nth 2 caller) 855 | :proc-name (plist-get args :name) 856 | :executable (car (plist-get args :command)) 857 | :args (cdr (plist-get args :command))))) 858 | (snitch--wrap-internal event "process" orig-fun args))) 859 | 860 | (defun snitch--wrap-make-network-process (orig-fun &rest args) 861 | "Wrap network connections with snitch firewall. 862 | 863 | Wrap a call to ‘make-network-process’ in the snitch firewall 864 | decision engine. ORIG-FUN is called only if the snitch firewall 865 | rules permit it, receiving its default arguments ARGS." 866 | (let* ((bt (snitch--backtrace t)) 867 | (caller (snitch--responsible-caller bt)) 868 | (event (snitch-network-entry 869 | :timestamp (time-to-seconds (current-time)) 870 | :src-fn (nth 0 caller) 871 | :src-path (nth 1 caller) 872 | :src-pkg (nth 2 caller) 873 | :proc-name (plist-get args :name) 874 | :host (plist-get args :host) 875 | :port (snitch--service-to-port (plist-get args :service)) 876 | :family (plist-get args :family)))) 877 | (snitch--wrap-internal event "network" orig-fun args))) 878 | 879 | (defun snitch--register-wrapper-fns () 880 | "Enable snitch firewall wrapping functions. 881 | 882 | Add snitch decision engine around the lowest-level Emacs 883 | functions responsible for launching subprocesses and opening 884 | network connections." 885 | ;; lowest-level functions, implemented in C 886 | (add-function :around (symbol-function 'make-network-process) 887 | #'snitch--wrap-make-network-process) 888 | (add-function :around (symbol-function 'make-process) 889 | #'snitch--wrap-make-process) 890 | ;; TODO: are all of these covered? 891 | ;; call-process 892 | ;; start-process 893 | ;; url-retrieve 894 | ;; open-network-stream 895 | ) 896 | 897 | (defun snitch--unregister-wrapper-fns () 898 | "Unload the snitch decision engine wrapping functions." 899 | (remove-function (symbol-function 'make-network-process) 900 | #'snitch--wrap-make-network-process) 901 | (remove-function (symbol-function 'make-process) 902 | #'snitch--wrap-make-process)) 903 | 904 | 905 | (defun snitch--init () 906 | "Initialize snitch.el firewall, enabling globally." 907 | (interactive) 908 | (when (bound-and-true-p snitch-mode) 909 | (snitch--deinit)) 910 | (when snitch-trace-timers (snitch--activate-timer-trace)) 911 | (when (snitch--register-wrapper-fns) t) 912 | (run-hooks 'snitch-init-hook)) 913 | 914 | (defun snitch--deinit (&optional rerequire) 915 | "Unload snitch.el firewall, disabling globally. 916 | 917 | When the optional argument REREQUIRE is t, the snitch feature is 918 | completely unloaded and re-loaded into Emacs. Autoloaded symbols 919 | may be lost in this process." 920 | (interactive) 921 | (snitch--deactivate-timer-trace) 922 | (snitch--stop-log-prune-timer) 923 | (snitch--unregister-wrapper-fns) 924 | (run-hooks 'snitch-deinit-hook) 925 | (when rerequire 926 | (unload-feature 'snitch t) 927 | (when (require 'snitch) t))) 928 | 929 | ;;;###autoload 930 | (defun snitch-restart () 931 | "Restart the snitch firewall. 932 | 933 | Unload and reload all hooks and timers." 934 | (interactive) 935 | (when (snitch--deinit) 936 | (snitch--init))) 937 | 938 | ;;;###autoload 939 | (defun snitch-version () 940 | "Return loaded snitch’s version number as a string." 941 | snitch--version) 942 | 943 | ;;;###autoload 944 | (define-minor-mode snitch-mode 945 | "Toggle snitch firewall on and off. 946 | 947 | The snitch firewall is enabled as a global minor mode, and 948 | monitors network connections and subprocesses in the background. 949 | 950 | For more information, use ‘M-x describe-package snitch’. 951 | 952 | To customize, use ‘M-x customize-group snitch’. 953 | 954 | No mode-line annotation is displayed by default, but this can be 955 | changed by customizing ‘snitch-lighter’. To add custom code 956 | after start or shutdown, add hooks to ‘snitch-init-hook’ or 957 | ‘snitch-deinit-hook’." 958 | :global t 959 | :lighter snitch-lighter 960 | :group 'snitch 961 | (if snitch-mode 962 | (snitch--init) 963 | (snitch--deinit))) 964 | 965 | (provide 'snitch) 966 | 967 | ;;; snitch.el ends here 968 | -------------------------------------------------------------------------------- /test_snitch.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | set -e 3 | 4 | LINT_FILES=' 5 | snitch.el 6 | snitch-backtrace.el 7 | snitch-custom.el 8 | snitch-filter.el 9 | snitch-log.el 10 | snitch-timer.el' 11 | 12 | QUOTED_LINT_FILES="" 13 | for file in ${LINT_FILES}; do 14 | QUOTED_LINT_FILES="$QUOTED_LINT_FILES \"$file\""; 15 | done 16 | 17 | #lint-compile: 18 | # @if [ -n "${LINT_COMPILE_FILES}" ]; then \ 19 | # echo "# Run byte compilation on $(call split_with_commas,${MAKEL_LINT_COMPILE_FILES})…"; \ 20 | # ${BATCH} \ 21 | # --eval "(setq byte-compile-error-on-warn t)" \ 22 | # $(if ${LINT_COMPILE_OPTIONS},${LINT_COMPILE_OPTIONS}) \ 23 | # --funcall batch-byte-compile \ 24 | # ${MAKEL_LINT_COMPILE_FILES}; \ 25 | # fi 26 | 27 | echo "byte-compiling..." 28 | emacs -batch \ 29 | --eval "(package-initialize)" \ 30 | --eval "(setq load-path (seq-filter \ 31 | (lambda (x) (not (string-match \"/snitch\" x))) load-path))" \ 32 | --eval "(add-to-list 'load-path \"~/.emacs.d/snitch/\")" \ 33 | --eval "(require 'snitch)" \ 34 | --eval "(message \"Testing snitch version: %s\" (snitch-version))" \ 35 | --eval "(setq byte-compile-error-on-warn t)" \ 36 | --funcall batch-byte-compile \ 37 | ${LINT_FILES} 38 | 39 | echo "checkdoc..." 40 | # Just print findings, don't exit on errors 41 | emacs -batch \ 42 | --eval "(mapcar #'checkdoc-file (list ${QUOTED_LINT_FILES}))" 43 | 44 | echo "package-lint..." 45 | emacs -batch \ 46 | --eval "(package-initialize)" \ 47 | --eval "(setq load-path (seq-filter \ 48 | (lambda (x) (not (string-match \"/snitch\" x))) load-path))" \ 49 | --eval "(add-to-list 'load-path \"~/.emacs.d/snitch/\")" \ 50 | --eval "(require 'snitch)" \ 51 | --eval "(message \"Testing snitch version: %s\" (snitch-version))" \ 52 | --eval "(setq package-lint-batch-fail-on-warnings nil)" \ 53 | --eval "(setq package-lint-main-file \"snitch.el\")" \ 54 | -L . \ 55 | -f package-lint-batch-and-exit \ 56 | snitch.el snitch-backtrace.el snitch-custom.el \ 57 | snitch-filter.el snitch-log.el snitch-timer.el 58 | 59 | echo "ert tests..." 60 | emacs -batch \ 61 | --eval "(package-initialize)" \ 62 | --eval "(setq load-path (seq-filter \ 63 | (lambda (x) (not (string-match \"/snitch\" x))) load-path))" \ 64 | --eval "(add-to-list 'load-path \"~/.emacs.d/snitch/\")" \ 65 | --eval "(require 'snitch)" \ 66 | --eval "(message \"Testing snitch version: %s\" (snitch-version))" \ 67 | -l ert -l snitch-test.el \ 68 | -f ert-run-tests-batch-and-exit 69 | --------------------------------------------------------------------------------