diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,93 @@ +Adblock2Privoxy +Convert adblock config files to privoxy format + +Introduction + +AdBlock Plus browser plugin has great block lists provided by big community, but it is client software and cannot work on a server as a proxy. + +Privoxy proxy has good potential to block ads at server side, but it experiences acute shortage of updated block lists. + +This software converts adblock lists to privoxy config files format. + +Almost all adblock features are supported including + +- block/unblock requests (on privoxy) + all syntax features are supported except for regex templates matching host name +- hide/unhide page elements (via CSS) + all syntax features are supported +- all block request options except for outdated ones: + Supported: script, image, stylesheet, object, xmlhttprequest, object-subrequest, subdocument,document, elemhide, other, popup, third-party, domain=..., match-case, donottrack + Unsupported: collapse, background, xbl, ping and dtd + +Tested with privoxy version 3.0.21. Element blocking feature requires a webserver to serve CSS files. See Nginx and Apache config examples provided. + +Usage + +adblock2privoxy [OPTION...] adblockFiles... + -V --version show version number + -p PATH --privoxyDir=PATH privoxy config output path (required) + -w PATH --webDir=PATH css files output path (optional, privoxyDir is used by default) +Example: adblock2privoxy -p /etc/privoxy -w /var/www/privoxy easylist.txt advblock.txt my_custom.txt + +How to apply results + +1) Install privoxy. Optionally setup it as transparent proxy + +2) Change privoxy config file: Add following lines + +actionsfile ab2p.system.action +actionsfile ab2p.action +filterfile ab2p.system.filter +filterfile ab2p.filter +3) Install nginx or apache webserver + +Nginx config example: + +server { + listen 80; + #ab2p css domain name (optional) + server_name privoxy.zubr.me; + + #root = webDir parameter value + root /var/www/privoxy; + + location ~ ^/[^/.]+\..+/ab2p.css$ { + # first reverse domain names order + rewrite ^/([^/]*?)\.([^/.]+)(?:\.([^/.]+))?(?:\.([^/.]+))?(?:\.([^/.]+))?(?:\.([^/.]+))?(?:\.([^/.]+))?(?:\.([^/.]+))?(?:\.([^/.]+))?/ab2p.css$ /$9/$8/$7/$6/$5/$4/$3/$2/$1/ab2p.css last; + } + + location ~ (^.*/+)[^/]+/+ab2p.css { + # then try to get CSS for current domain + # if it is unavailable - get CSS for parent domain + try_files $uri $1ab2p.css; + } +} +Apache config example: + + + #ab2p css domain name (optional) + ServerName www.example.com + + #root = webDir parameter value + DocumentRoot /var/www/privoxy + + + RewriteEngine on + + # first reverse domain names order + RewriteRule ^/([^/]*?)\.([^/.]+)(?:\.([^/.]+))?(?:\.([^/.]+))?(?:\.([^/.]+))?(?:\.([^/.]+))?(?:\.([^/.]+))?(?:\.([^/.]+))?(?:\.([^/.]+))?/ab2p.css$ /$9/$8/$7/$6/$5/$4/$3/$2/$1/ab2p.css [N] + + # then try to get CSS for current domain + # if it is unavailable - get CSS for parent domain + RewriteCond %{DOCUMENT_ROOT}/%{REQUEST_FILENAME} !-f + RewriteRule (^.*/+)[^/]+/+ab2p.css$ $1ab2p.css [N] + +4) Download adblock config files. Some download locations +EasyList: ​https://easylist.adblockplus.org/en/ +Russian AD list: ​https://code.google.com/p/ruadlist/ + +5) Run adblock2privoxy providing privoxy dir, web dir and adblock input files + +6) Restart privoxy and apache to load updated configs + +Clone repository from ​http://projects.zubr.me/adblock2privoxy.git diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/adblock2privoxy.cabal b/adblock2privoxy.cabal new file mode 100644 --- /dev/null +++ b/adblock2privoxy.cabal @@ -0,0 +1,70 @@ +name: adblock2privoxy +version: 1.0.0 +cabal-version: >= 1.6 +build-type: Simple +author: Alexey Zubritsky +data-files: + templates/ab2p.system.action, + templates/ab2p.system.filter +extra-source-files: README +license: GPL-3 +maintainer: Alexey Zubritsky +license-file: LICENSE +stability: stable +synopsis: Convert adblock config files to privoxy format +description: + AdBlock Plus browser plugin has great block list files provided by big community, + but it is client software and cannot work on a server as proxy. + . + Privoxy proxy has good potential to block ads at server side, + but it experiences acute shortage of updated block lists. + . + This software converts adblock lists to privoxy config files format. + . + Almost all adblock features are supported including + - block/unblock requests (on privoxy) + all syntax features are supported except for regex templates matching host name + - hide/unhide page elements (via CSS) + all syntax features are supported + - all block request options except for outdated ones: + Supported: script, image, stylesheet, object, xmlhttprequest, object-subrequest, subdocument, + document, elemhide, other, popup, third-party, domain=..., match-case, donottrack + Unsupported: collapse, background, xbl, ping and dtd +homepage: https://projects.zubr.me/wiki/adblock2privoxy +category: Web + +executable adblock2privoxy + hs-source-dirs: src + main-is: Main.hs + build-depends: + base >= 4 && < 5, + parsec, + mtl, + containers, + filepath, + directory, + MissingH, + parsec-permutation, + time >=1.4.0 && <1.5, + old-locale >=1.0.0 && <1.1, + strict >=0.3.2 && <0.4 + ghc-options: -Wall + other-modules: + InputParser, + ParsecExt, + Utils, + ParserExtTests, + ElementBlocker, + PolicyTree, + OptionsConverter, + PatternConverter, + UrlBlocker, + Templates, + PopupBlocker, + Statistics, + SourceInfo + +source-repository this + type: git + location: ​http://projects.zubr.me/adblock2privoxy.git + tag: 1.0.0 diff --git a/src/ElementBlocker.hs b/src/ElementBlocker.hs new file mode 100644 --- /dev/null +++ b/src/ElementBlocker.hs @@ -0,0 +1,103 @@ +module ElementBlocker ( +elemBlock +) where +import InputParser hiding (Policy(..)) +import qualified InputParser +import PolicyTree +import Control.Applicative +import qualified Data.Map as Map +import Data.Maybe +import Utils +import System.IO hiding (hGetContents) +import System.FilePath +import Data.List +import System.Directory +import qualified Templates +import Control.Monad + + +type BlockedRulesTree = DomainTree [Pattern] +data ElemBlockData = ElemBlockData [Pattern] BlockedRulesTree deriving Show + +elemBlock :: String -> [String] -> [Line] -> IO () +elemBlock path info = writeElemBlock . elemBlockData + where + writeElemBlock :: ElemBlockData -> IO () + writeElemBlock (ElemBlockData flatPatterns rulesTree) = + do + let debugPath = path "debug" + createDirectoryIfMissing True path + cont <- getDirectoryContents path + _ <- sequence $ removeOld <$> cont + createDirectoryIfMissing True debugPath + writeBlockTree path debugPath rulesTree + writePatterns info (path "ab2p.common.css") (debugPath "ab2p.common.css") flatPatterns + removeOld entry' = + let entry = path entry' + in do + isDir <- doesDirectoryExist entry + if isDir then when (head entry' /= '.') $ removeDirectoryRecursive entry + else when (takeExtension entry == ".css") $ removeFile entry + writeBlockTree :: String -> String -> BlockedRulesTree -> IO () + writeBlockTree normalNodePath debugNodePath (Node name patterns children) = + do + createDirectoryIfMissing True normalPath + createDirectoryIfMissing True debugPath + _ <- sequence (writeBlockTree normalPath debugPath <$> children) + writePatterns ["See ab2p.common.css for sources info"] normalFilename debugFilename patterns + where + normalPath + | null name = normalNodePath + | otherwise = normalNodePath name + debugPath + | null name = debugNodePath + | otherwise = debugNodePath name + normalFilename = normalPath "ab2p.css" + debugFilename = debugPath "ab2p.css" + writePatterns :: [String] -> String -> String -> [Pattern] -> IO () + writePatterns _ _ _ [] = return () + writePatterns info' normalFilename debugFilename patterns = + do + writeCssFile debugFilename $ intercalate "\n" $ (++ Templates.blockCss) <$> patterns + writeCssFile normalFilename $ intercalate "\n" $ (++ Templates.blockCss) <$> intercalate "," <$> + splitEvery 4000 patterns + where + splitEvery n = takeWhile (not . null) . unfoldr (Just . splitAt n) + writeCssFile filename content = + do outFile <- openFile filename WriteMode + hPutStrLn outFile "/*" + _ <- mapM (hPutStrLn outFile) info' + hPutStrLn outFile "*/" + hPutStrLn outFile content + hClose outFile + +elemBlockData :: [Line] -> ElemBlockData +elemBlockData input = ElemBlockData + (Map.foldrWithKey appendFlatPattern [] policyTreeMap) + (Map.foldrWithKey appendTreePattern (Node "" [] []) policyTreeMap) + where + policyTreeMap :: Map.Map String PolicyTree + policyTreeMap = Map.unionWith (trimTree Block .*. mergePolicyTrees Unblock) + blockLinesMap + (erasePolicy Block <$> unblockLinesMap) + where + blockLinesMap = Map.fromListWith (mergeAndTrim Block) (mapMaybe blockLine input) + unblockLinesMap = Map.fromListWith (mergeAndTrim Unblock) (mapMaybe unblockLine input) + unblockLine (Line _ (ElementHide domains InputParser.Unblock pattern)) = (,) pattern <$> restrictionsTree Unblock domains + unblockLine _ = Nothing + blockLine (Line _ (ElementHide domains InputParser.Block pattern)) = (,) pattern <$> restrictionsTree Block domains + blockLine _ = Nothing + + appendTreePattern :: Pattern -> PolicyTree -> BlockedRulesTree -> BlockedRulesTree + appendTreePattern pattern policyTree + | null $ _children policyTree = id + | otherwise = mergeTrees appendPattern policyTree + where appendPattern policy patterns = case policy of + Block -> pattern:patterns + _ -> patterns + + appendFlatPattern :: Pattern -> PolicyTree -> [Pattern] -> [Pattern] + appendFlatPattern pattern policyTree patterns + | null (_children policyTree) && _value policyTree == Block = pattern:patterns + | otherwise = patterns + diff --git a/src/InputParser.hs b/src/InputParser.hs new file mode 100644 --- /dev/null +++ b/src/InputParser.hs @@ -0,0 +1,210 @@ +module InputParser ( +Line (..), +Restrictions (..), +RequestOptions (..), +Record (..), +RequestType (..), +Pattern, +Domain, +Policy (..), +RecordSource (..), +adblockFile, +recordSourceText +) +where +import Control.Applicative hiding ((<|>)) +import Text.ParserCombinators.Parsec hiding (Line, many, optional) +import Data.List.Utils (split) +import Data.List +import Data.Char +import Data.Monoid +import Control.Monad +import Text.Parsec.Permutation +import System.FilePath + +-------------------------------------------------------------------------- +---------------------------- data model --------------------------------- +-------------------------------------------------------------------------- + +-- composite +data Line = Line RecordSource Record + deriving (Show,Eq) + +data RecordSource = RecordSource { _position :: SourcePos, _rawRecord :: String } deriving (Show,Eq) +data Policy = Block | Unblock deriving (Show, Eq, Read, Ord) +data Record = Error String | + Comment String | + ElementHide (Restrictions Domain) Policy Pattern | + RequestBlock Policy Pattern RequestOptions + deriving (Read,Show,Eq) + +data RequestType = Script | Image | Stylesheet | Object | Xmlhttprequest | Popup | + ObjectSubrequest | Subdocument | Document | Other + deriving (Read, Show,Eq) + +data RequestOptions = RequestOptions { + _requestType :: Restrictions RequestType, + _thirdParty :: Maybe Bool, + _domain :: Restrictions Domain, + _matchCase :: Bool, + _collapse :: Maybe Bool, + _doNotTrack :: Bool, + _elemHide :: Bool, + _unknown :: [String] + } + deriving (Read,Show,Eq) + +-- primitive +type Pattern = String +type Domain = String + +-- helpers +data Restrictions a = Restrictions { + _positive :: Maybe [a], + _negative :: [a]} + deriving (Read,Show,Eq) + +recordSourceText :: RecordSource -> String +recordSourceText (RecordSource position rawRecord) + = concat [rawRecord, " (", takeFileName $ sourceName position, ": ", show $ sourceLine position, ")"] + +-------------------------------------------------------------------------- +---------------------------- parsers ------------------------------------ +-------------------------------------------------------------------------- + +adblockFile :: Parser [Line] +adblockFile = header *> sepEndBy line (oneOf eol) + where + header = string "[Adblock Plus " <* version <* string "]" <* lineEnd + version = join <$> sepBy (many1 digit) (char '.') + + +line :: Parser Line +line = do + position <- getPosition + let text = lookAhead (manyTill anyChar lineEnd) + sourcePosition = RecordSource position <$> text + Line <$> sourcePosition <*> choice (try <$> [comment, elementHide, match, unknown]) "filtering rule" + + + +elementHide :: Parser Record +elementHide = ElementHide <$> domains ',' <*> excludeMatch <*> pattern + where + excludeMatch = char '#' *> ((Block <$ string "#") <|> (Unblock <$ string "@#")) + pattern = manyTill anyChar (lookAhead lineEnd) + +match :: Parser Record +match = RequestBlock <$> excludeMatch <*> pattern <*> options + where + excludeMatch = option Block $ Unblock <$ count 2 (char '@') + patternEnd = try (return () <* char '$' <* requestOptions <* lineEnd) <|> try (return () <* lineEnd) + pattern = manyTill (noneOf "#") (lookAhead patternEnd) + options = option '$' (char '$') *> requestOptions + +comment :: Parser Record +comment = Comment <$> (separatorLine <|> commentText) + where commentText = char '!' *> many notLineEnd + separatorLine = lookAhead lineEnd *> return "" + +unknown :: Parser Record +unknown = Error "Record type detection failed" <$ skipMany notLineEnd + +requestOptions :: Parser RequestOptions +requestOptions = runPermParser $ RequestOptions + <$> (fixRestrictions <$> requestTypes) + <*> (getMaybeAll <$> requestOptionNorm "ThirdParty") + <*> (fixRestrictions <$> optionalDomain) + <*> (getAllOrFalse <$> requestOptionNorm "MatchCase") + <*> (getMaybeAll <$> requestOptionNorm "Collapse") + <*> (getAllOrFalse <$> requestOptionNorm "Donottrack") + <*> (getAllOrFalse <$> requestOptionNorm "Elemhide") + <* manyPerm separator + <*> unknownOption + where + optionalDomain = optionPerm noRestrictions $ try domainOption + requestTypes = Restrictions <$> (Just <$> manyPerm (try requestTypeOption)) <*> manyPerm (try notRequestTypeOption) + notRequestTypeOption = char '~' *> requestTypeOption + requestOptionNorm = manyPerm.try.requestOption + separator = try (lineSpaces *> char ',' <* lineSpaces) + unknownOption = manyPerm $ try optionName + +requestOption :: String -> Parser All +requestOption name = All <$> option True (char '~' *> return False) <* checkOptionName name + + + +requestTypeOption :: Parser RequestType +requestTypeOption = do t <- optionName + case reads t of + [(result, "")] -> return result + _ -> pzero "request type" + + + +domainOption :: Parser (Restrictions Domain) +domainOption = checkOptionName "Domain" *> lineSpaces *> char '=' *> lineSpaces *> domains '|' + +optionName :: Parser String +optionName = asOptionName <$> ((:) <$> letter <*> many (alphaNum <|> char '-')) + where + capitalize [] = "" + capitalize (x:xs) = toUpper x:(toLower<$>xs) + ws = split "-" + asOptionName = join.liftA capitalize.ws + +checkOptionName :: String -> Parser () +checkOptionName name = do t <- optionName + when (name /= t) (pzero "option type") + +domain :: Parser Domain +domain = join <$> intersperse "." <$> parts + where + parts = sepBy1 domainPart (char '.') + domainPart = many1 (alphaNum <|> char '-') + +domains :: Char -> Parser (Restrictions Domain) +domains sep = fixRestrictions <$> runPermParser restrictions + where + restrictions = Restrictions <$> (Just <$> manyPerm (try domain)) <*> manyPerm (try notDomain) <* manyPerm (try separator) + separator = lineSpaces *> char sep <* lineSpaces + notDomain = char '~' *> domain + +--helpers +eol :: String +eol = "\r\n" + +lineSpaces :: Parser () +lineSpaces = skipMany (satisfy isLineSpace) "white space" + where isLineSpace c = c == ' ' || c == '\t' + +lineEnd :: Parser Char +lineEnd = oneOf eol <|> ('\0' <$ eof) + +notLineEnd :: Parser Char +notLineEnd = noneOf eol + + +getMaybeAll :: [All] -> Maybe Bool +getMaybeAll [] = Nothing +getMaybeAll list = Just $ getAll $ mconcat list + +getAllOrFalse :: [All] -> Bool +getAllOrFalse [] = False +getAllOrFalse list = getAll $ mconcat list + +noRestrictions :: Restrictions a +noRestrictions = Restrictions Nothing [] + +fixRestrictions :: (Eq a) => Restrictions a -> Restrictions a +fixRestrictions = deduplicate.allowAll + where + allowAll (Restrictions (Just []) n) = Restrictions Nothing n + allowAll a = a + deduplicate (Restrictions (Just p) n) = Restrictions (Just $ nub p) (nub n) + deduplicate a = a + + + + + diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,79 @@ +module Main where +import InputParser +import System.IO +import ElementBlocker +import UrlBlocker +import Text.ParserCombinators.Parsec hiding (Line, many, optional) +import Statistics +import Control.Applicative hiding (many) +import SourceInfo +import System.Console.GetOpt +import System.Environment +import Control.Monad +import Templates (writeTemplateFiles) +import Data.Time.Clock (getCurrentTime) + +data Options = Options + { _showVersion :: Bool + , _privoxyDir :: FilePath + , _webDir :: FilePath + } deriving Show + +options :: [OptDescr (Options -> Options)] +options = + [ Option ['V'] ["version"] + (NoArg (\ opts -> opts { _showVersion = True })) + "show version number" + , Option ['p'] ["privoxyDir"] + (ReqArg (\ f opts -> opts { _privoxyDir = f }) + "PATH") + "privoxy config output path (required)" + , Option ['w'] ["webDir"] + (ReqArg (\ f opts -> opts { _webDir = f }) + "PATH") + "css files output path (optional, privoxyDir is used by default)" + ] + +parseOptions :: [String] -> IO (Options, [String]) +parseOptions argv = + case getOpt Permute options argv of + (opts,nonOpts,[] ) -> + case foldl (flip id) (Options False [] []) opts of + Options False [] _ -> writeError "Privoxy dir is not specified.\n" + opts'@(Options _ privoxyDir []) -> return (opts'{_webDir = privoxyDir}, nonOpts) + opts' -> return (opts', nonOpts) + (_,_,errs) -> writeError $ concat errs + where + writeError msg = ioError $ userError $ msg ++ usageInfo header options + header = "Usage: adblock2privoxy [OPTION...] adblockFiles..." + + +processFiles :: String -> String -> [String] -> IO [()] +processFiles privoxyDir webDir filenames = do + let parseFile filename = do + putStrLn $ "parse " ++ filename + inputFile <- openFile filename ReadMode + text <- hGetContents inputFile + case parse adblockFile filename text of + Right parsed -> return (parsed, extractInfo parsed, inputFile) + Left msg -> return ([], NoInfo, inputFile) <$ putStrLn $ show msg + + (parsed, sourceInfo, handlers) <- unzip3 <$> mapM parseFile filenames + showInfo' <- showInfo <$> getCurrentTime + let parsed' = concat parsed + info = (sourceInfo >>= showInfo') ++ ["------- end ------\n"] + stat privoxyDir info parsed' + elemBlock webDir info parsed' + urlBlock privoxyDir info parsed' + writeTemplateFiles privoxyDir + sequence $ hClose <$> handlers + +main::IO() +main = do + args <- getArgs + (opts, filenames) <- parseOptions args + when (_showVersion opts) $ putStrLn "adblock2privoxy version 1.0" + when (not . null $_privoxyDir opts) $ + do _ <- processFiles (_privoxyDir opts) (_webDir opts) filenames + putStrLn "done" + diff --git a/src/OptionsConverter.hs b/src/OptionsConverter.hs new file mode 100644 --- /dev/null +++ b/src/OptionsConverter.hs @@ -0,0 +1,158 @@ +module OptionsConverter ( + HeaderFilters, + Filter (..), + HeaderType (..), + HeaderFilter (..), + headerFilters +) where +import InputParser +import Control.Applicative +import Control.Monad +import Data.List +import Data.Monoid hiding (Any) +import Data.Maybe +import Data.String.Utils (replace) +import {-# SOURCE #-} UrlBlocker + +type FilterFabrique = Policy -> RequestOptions -> HeaderPolicy +data HeaderType = HeaderType {_name :: String, _taggerType :: TaggerType, _level :: Int, + _typeCode :: Char, _fabrique :: FilterFabrique} +data Filter = Filter { _code :: String, _regex :: String, _orEmpty :: Bool } deriving Eq +data HeaderPolicy = Specific Filter | Any | None deriving Eq +data HeaderFilter = HeaderFilter HeaderType Filter +type HeaderFilters = [[HeaderFilter]] + +allTypes :: [HeaderType] +allTypes = [accept, contentType, requestedWith, referer] + +accept, contentType, requestedWith, referer :: HeaderType +accept = HeaderType "accept" Client 1 'A' acceptFilter +contentType = HeaderType "content-type" Server 1 'C' contentTypeFilter +requestedWith = HeaderType "x-requested-with" Client 1 'X' requestedWithFilter +referer = HeaderType "referer" Client 2 'R' refererFilter + + +headerFilters :: Policy -> Int -> RequestOptions -> Maybe HeaderFilters +headerFilters _ 0 _ = Just [] +headerFilters policy level requestOptions@RequestOptions{_requestType = requestType} + = let requestOptions' = requestOptions{_requestType = convertPopup $ convertOther requestType} + in do + nextLevel <- headerFilters policy (level - 1) requestOptions' + let + passthrough = checkPassthrough requestOptions' + filters = do + headerType <- allTypes + guard (_level headerType == level) + case (_fabrique headerType) policy requestOptions' of + Specific filter' -> return $ Just $ HeaderFilter headerType filter' + None -> return Nothing + Any -> mzero + when (not passthrough && all isNothing filters && not (null filters)) $ fail "filters blocked" + return $ case catMaybes filters of + [] -> nextLevel + filters' -> filters' : nextLevel + +convertPopup :: Restrictions RequestType -> Restrictions RequestType +convertPopup (Restrictions positive negative)= Restrictions positive' negative + where + positiveContentTypes = fromMaybe [] positive >>= contentTypes True + positive' | Popup `elem` negative && null positiveContentTypes = Nothing + | otherwise = positive + +convertOther :: Restrictions RequestType -> Restrictions RequestType +convertOther (Restrictions positive negative)= Restrictions positive' negative' + where + allContentOptions = [Script, Image, Stylesheet, Object, ObjectSubrequest, Document] + positiveList = fromMaybe [] positive + negative' | Other `elem` positiveList = allContentOptions \\ positiveList + | otherwise = negative + positive' | Other `elem` negative = Just $ allContentOptions \\ negative' + | positive == Just [Other] = Nothing + | otherwise = positive + +checkPassthrough :: RequestOptions -> Bool +checkPassthrough RequestOptions {_requestType = (Restrictions positive _) } + = fromMaybe False $ (not . null . intersect [Subdocument, Popup]) <$> positive + +acceptFilter, contentTypeFilter, requestedWithFilter, refererFilter :: FilterFabrique + +contentTypeFilter policy (RequestOptions (Restrictions positive negative) thirdParty _ _ _ _ _ _) + | fromMaybe True emptyPositive && (not $ isNothing positive) = None + | result == mempty = Any + | otherwise = Specific $ Filter code regex orEmpty + where + negative' | isNothing positive && fromMaybe False thirdParty = Document : negative + | otherwise = negative + negativePart = mappend ("n", "") <$> convert False negative' + positivePart = positive >>= convert True + result@(code, regex) = mconcat $ catMaybes [positivePart, negativePart] + orEmpty = (policy == Unblock) && isNothing positive + emptyPositive = null . filter (`notElem` (fromMaybe "" $ fst <$> negativePart)) . fst <$> positivePart + + convert _ [] = Nothing + convert include requestTypes | null code' = Nothing + | otherwise = Just (code', regex') + where contentTypes' = nub $ requestTypes >>= contentTypes include + code' = sort $ (head . dropWhile (`elem` "/(?:x-)")) <$> contentTypes' + regex' = lookahead contentTypes' "[\\s\\w]*" include + +acceptFilter excludePattern options = case contentTypeFilter excludePattern options of + Specific res -> Specific res {_orEmpty = False} + other -> other + + +requestedWithFilter _ RequestOptions{ _requestType = Restrictions positive negative } = + case result of + Nothing -> Any + Just result' -> Specific $ Filter (code result') (lookahead ["xmlhttprequest"] "\\s*" result') (not result') + where + code True = "x" + code False = "nx" + result | Xmlhttprequest `elem` negative = Just False + | Xmlhttprequest `elem` fromMaybe [] positive = Just True + | (hasContentTypes False negative) + && (fromMaybe True $ not . hasContentTypes True <$> positive) = Just True + | otherwise = Nothing + hasContentTypes include = not . all null . fmap (contentTypes include) + + +refererFilter policy RequestOptions{ _thirdParty = thirdParty, _domain = Restrictions positive negative } + | fromMaybe False emptyPositive = None + | result == mempty = Any + | otherwise = Specific $ Filter code regex orEmpty + where + negativePart = mappend ("n", "") <$> convert False negative + positivePart = positive >>= convert True + thirdPartyPart tp = (if tp then "t" else "nt", + concat ["(?", lookAheadPolicy $ not tp, + ":\\s*(?:https?:\\/\\/)?(?:[\\w.-]*\\.)?([\\w-]+\\.[\\w-]+)[^\\w.-].*\\1$)", + "\ns@^referer:.*@$&\\t$host@Di"]) + result@(code, regex) = mconcat $ catMaybes [positivePart, negativePart, thirdPartyPart <$> thirdParty] + emptyPositive = null . filter (`notElem` negative) <$> positive + orEmpty = (policy == Unblock) && (isNothing positive || (not $ fromMaybe True thirdParty)) + convert _ [] = Nothing + convert include domains = let + code' = intercalate "][" $ sort domains + regex' = lookahead domains "[^\\n]*[./]" include + in Just ("[" ++ code' ++ "]", regex') + +lookAheadPolicy :: Bool -> [Char] +lookAheadPolicy True = "=" +lookAheadPolicy False = "!" + +lookahead :: [String] -> String -> Bool -> String +lookahead list prefix include = join ["(?", lookAheadPolicy include, + ":", prefix ,"(?:", intercalate "|" $ excapeRx <$> list, "))"] + where + excapeRx = replace "/" "\\/" . replace "." "\\." + +contentTypes :: Bool -> RequestType -> [String] +contentTypes _ Script = ["/(?:x-)?javascript"] +contentTypes _ Image = ["image/"] +contentTypes _ Stylesheet = ["/css"] +contentTypes _ Object = ["video/","audio/","/(?:x-)?shockwave-flash"] +contentTypes _ ObjectSubrequest = ["video/","audio/","/octet-stream"] +contentTypes _ Document = ["/html", "/xml"] +contentTypes False Subdocument = ["/html", "/xml"] +contentTypes _ _ = [] + diff --git a/src/ParsecExt.hs b/src/ParsecExt.hs new file mode 100644 --- /dev/null +++ b/src/ParsecExt.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE RankNTypes, ScopedTypeVariables, FlexibleInstances #-} +module ParsecExt ( + CasesParser, + StateParser, + StringStateParser, + cases, + manyCases, + many1Cases, + oneCase +) where + +import Utils +import Control.Applicative hiding (many) +import Text.ParserCombinators.Parsec hiding ((<|>),State) +import Control.Monad.Trans +import Control.Monad.RWS +import Control.Monad.State +import Data.Maybe + +-- parser should consume some input to prevent infinite loop +manyCases :: (Monoid a, Monoid st) => Parser a -> StateParser st a +manyCases p = do acc <- get + put $ Just mempty + lift $ if isNothing acc + then return mempty + else p + +oneCase :: (Monoid a, Monoid st) => Parser a -> StateParser st a +oneCase p = do acc <- get + put $ Just mempty + lift $ if isNothing acc + then p + else pzero + +many1Cases :: Parser a -> StateParser st a +many1Cases = lift + +type StringStateParser = StateParser String +type StateParser st = StateT (Maybe st) Parser +type CasesParser st r = RWST () [r] String (StateParser st) + +optionMaybeTry :: StateParser st a -> StateParser st (Maybe a) +optionMaybeTry p = liftM Just (mapStateT try p) <|> return Nothing + +cases :: forall r st.(Monoid r) => [StateParser st r] -> Parser [r] +cases parsers = evalStateT stateParser Nothing + where stateParser = do + input <- lift getInput + let boxedParser = (mapRWST.mapStateT) lookAhead $ casesParser mempty parsers + (input', res) <- execRWST boxedParser () input + lift (setInput input') + return res + + +casesParser :: forall r st.(Monoid r) => r -> [StateParser st r] -> CasesParser st r () +casesParser _ [] = error "Empty parser list is not accepted" +casesParser acc parsers@(parser:next) = do + maybeRes <- lift (optionMaybeTry parser) + case maybeRes of + Nothing -> return () + Just res -> do + input <- lift.lift $ getInput + let acc' = acc <> res + if null input || null next + then do + modify (minList input) -- TODO: somehow use processed length to select min input + tell [acc'] + else do + st <- lift get + lift (put Nothing) + (mapRWST.mapStateT) lookAhead $ casesParser acc' next + lift (put st) + when (not.null $ input) $ casesParser acc' parsers + +------------------------------------------------------------------------------------------------ diff --git a/src/ParserExtTests.hs b/src/ParserExtTests.hs new file mode 100644 --- /dev/null +++ b/src/ParserExtTests.hs @@ -0,0 +1,125 @@ +module ParserExtTests ( +parseMorse, +encodeMorse +) where +import Utils +import ParsecExt +import Control.Applicative hiding (many) +import Text.ParserCombinators.Parsec hiding ((<|>),State) +import Control.Monad +import Data.List +import Data.Maybe +import Control.Monad.State + +--------------------------------------------------------------------------------------------- +------------------------- parsec ext usage samples ------------------------------------------ +--------------------------------------------------------------------------------------------- + +type ExampleCase = ([String], String, String) + +parsersChain :: [StringStateParser ExampleCase] +parsersChain = square3 prefix mid suffix + where -- all parsers except for last one should consume some input and give some output + prefix = manyCases ((:[]) <$> (string "ab" <|> string "zz")) + mid = many1Cases $ (:[]) <$> letter -- list of letters + suffix = many1Cases $ try $ many1 alphaNum + + +testParsecExt :: Either ParseError [([String], String, String)] +testParsecExt = parse (cases parsersChain <* string "$$") "x" "abebz12$$" + +testParseMorse :: Either ParseError [String] +testParseMorse = parseMorse "......-...-..---" + +-------------------------------------------------------------------------------- +--- Morse chars parsing: parse "......-...-..---" in all possible ways --------- +-------------------------------------------------------------------------------- + +morseChars :: [(String, Char)] +morseChars = [ (".-", 'A'), + ("-...", 'B'), + ("-.-.", 'C'), + ("-..", 'D'), + (".", 'E'), + ("..-.", 'F'), + ("--.", 'G'), + ("....", 'H'), + ("..", 'I'), + (".---", 'J'), + ("-.-", 'K'), + (".-..", 'L'), + ("--", 'M'), + ("-.", 'N'), + ("---", 'O'), + (".--.", 'P'), + ("--.-", 'Q'), + (".-.", 'R'), + ("...", 'S'), + ("-", 'T'), + ("..-", 'U'), + ("...-", 'V'), + (".--", 'W'), + ("-..-", 'X'), + ("-.--", 'Y'), + ("--..", 'Z'), + ("-----", '0'), + (".----", '1'), + ("..---", '2'), + ("...--", '3'), + ("....-", '4'), + (".....", '5'), + ("-....", '6'), + ("--...", '7'), + ("---..", '8'), + ("----.", '9')] + +morseCharCodes :: [String] +morseCharCodes = fst <$> morseChars + +-- HELLO = "......-...-..---" +encodeMorse :: String -> String +encodeMorse s = join $ fst <$> catMaybes (code <$> s) + where code c = find (\pair -> snd pair == c) morseChars + +decodeMorse :: [String] -> String +decodeMorse ss = snd <$> catMaybes (code <$> ss) + where code s = find (\pair -> fst pair == s) morseChars + + +-- find possibilites to continue from a given prefix +findMorseSteps :: String -> [String] -> [String] +findMorseSteps prefix codes = case find (== prefix) codes of + Nothing -> case filter (isPrefixOf prefix) codes of + [] -> [] + filtered -> findMorseSteps (prefix ++ ".") filtered + ++ findMorseSteps (prefix ++ "-") filtered + Just match -> [match] + +morseStepParser :: [String] -> Parser String +morseStepParser [] = pzero +morseStepParser [step] = string step +morseStepParser (step:steps') = string step <|> morseStepParser steps' + +morseParser :: Int -> StringStateParser (ZipListM String) +morseParser pos = do acc' <- get + let acc = case acc' of + Nothing -> "" + Just val -> val + candidates = filter (\x -> isPrefixOf acc x && acc /= x) morseCharCodes + steps = drop (length acc) <$> findMorseSteps acc candidates + parser = morseStepParser steps + res <- lift parser + put (Just $ acc ++ res) + return (zipListM $ (replicate pos "") ++ (res : repeat "")) + + +morseParsers :: [StringStateParser (ZipListM String)] +morseParsers = repeat morseParser <*> [0 ..] + +parseMorse :: String -> Either ParseError [String] +parseMorse s = (fmap.fmap) postProcess $ parseMorseRaw "x" s + where + parseMorseRaw = parse (cases $ morseParsers) + postProcess = decodeMorse.toLists + toLists = (takeWhile $ not.null) . getZipListM + diff --git a/src/PatternConverter.hs b/src/PatternConverter.hs new file mode 100644 --- /dev/null +++ b/src/PatternConverter.hs @@ -0,0 +1,193 @@ +module PatternConverter ( +makePattern, +parseUrl +) where +import InputParser +import Control.Applicative hiding (many) +import Text.ParserCombinators.Parsec hiding (Line, (<|>)) +import Control.Monad.State +import Data.List +import Data.Maybe +import Data.String.Utils (replace) +import Data.List.Utils (split) +import ParsecExt +import Utils + +data SideBind = Hard | Soft | None deriving (Show, Eq) + +data UrlPattern = UrlPattern { + _bindStart :: SideBind, + _proto :: String, + _host :: String, + _query :: String, + _bindEnd :: SideBind, + _regex :: Bool } + deriving (Show) + +makePattern :: Bool -> UrlPattern -> Pattern +makePattern matchCase (UrlPattern bindStart proto host query bindEnd isRegex) + | query' == "" = host' + | otherwise = host' ++ separator' ++ query' + where + separator' + | matchCase = "/(?-i)" + | otherwise = "/" + host' = case host of + "" -> "" + _ -> changeFirst.changeLast $ host + where + changeLast [] = [] + changeLast [lst] + | lst == '|' || lst `elem` hostSeparators = [] + | lst == '*' || lst == '\0' = "*." + | otherwise = lst : "*." + changeLast (c:cs) = c : changeLast cs + + changeFirst [] = [] + changeFirst (first:cs) + | first == '*' = '.' : '*' : cs + | bindStart == Hard || proto /= "" = first : cs + | otherwise = '.' : '*' : first : cs + + query' = case query of + "" -> "" + (start:other) -> + if isRegex then query + else case query of + '*' : '/' : other' -> replaceQuery '/' other' True + '*' : '^' : other' -> replaceQuery '^' other' True + _ -> replaceQuery start other (bindStart == None && host == "") + where + replaceQuery c cs openStart = replaceFirst c openStart ++ (join . map replaceWildcard $ cs) ++ queryEnd + replaceFirst '*' _ = ".*" + replaceFirst c openStart + | c == '/' || c == '^' = if openStart + then "(.*" ++ replaceWildcard c ++ ")?" + else "" + | otherwise = if openStart + then ".*" ++ replaceWildcard c + else replaceWildcard c + + queryEnd = if bindEnd == None then "" else "$" + + replaceWildcard c + | c == '^' = "[^\\w%.-]" + | c == '*' = ".*" + | c `elem` special = '\\' : [c] + | otherwise = [c] + where special = "?$.+[]{}()\\|" -- also ^ and * are special + + +hostSeparators :: String +hostSeparators = "^/" + +parseUrl :: Pattern -> Either ParseError [UrlPattern] +parseUrl = + let raw = makeUrls <$> bindStart <*> cases urlParts <*> bindEnd + in parse (join <$> (fmap.fmap) postfilter raw) "url" + where + makeUrls start mid end = makeUrl <$> pure start <*> mid <*> pure end + makeUrl start (proto, host, query) end = UrlPattern start proto host query end False + + bindStart = (try (Soft <$ string "||") <|> try (Hard <$ string "|") <|> return None) "query start" + queryEnd = (char '|' <* eof) <|> ('\0' <$ eof) <|> char '\0' "query end" + bindEnd = (\c -> if c == '|' then Hard else None) <$> queryEnd + port = option False $ many1 (noneOf ":") *> char ':' *> many1 (digit <|> char '*') *> optionMaybe (oneOf "/^") *> (True <$ queryEnd) + + hostChar :: Parser Char + hostChar = alphaNum <|> oneOf ".-:" + + protocols :: [String] + protocols = ["https://", "http://"] + + protocolsSeparator :: String + protocolsSeparator = ";" + + protocolChar :: Parser Char + protocolChar = oneOf (delete '/' $ nub $ join protocols) + + postfilter :: UrlPattern -> [UrlPattern] + postfilter url@(UrlPattern bs proto host query be _) = regular ++ regex -- ++ www + where + regex = if proto == "" + && host == "" + && "/" `isPrefixOf` query + && length query > 2 + && "/" `isSuffixOf` query + then + let query' = take (length query - 2) . drop 1 $ query + in [UrlPattern bs "" "" query' be True] + else [] + regular = let + leftBound = bs /= None || proto /= "" + rightBound = be /= None || query /= "" + orphanQuery = leftBound && host == "" && query /= "" && not ("*" `isPrefixOf` query) + duplicateHostStar = host == "*" + hostHasDot = isJust $ find (\c -> c == '.' || c == '*') host + firstLevelHost = host /= "" && not hostHasDot && leftBound && rightBound + hasLegalPort = case parse port "host" host of + Right val -> val + _ -> False + hasIllegalPort = not hasLegalPort && ":" `isInfixOf` host + in if not (orphanQuery || duplicateHostStar || firstLevelHost || hasIllegalPort) + then + let + query' = if "*" `isSuffixOf` host && query /= "" then '*' : query else query + in [url {_query = query'}] + else [] +-- www = case regular of +-- [regular'] -> [regular'{_host = "www." ++ host} | +-- bs == Soft && +-- proto == "" && +-- host /= "" && +-- not ("*" `isPrefixOf` host) && +-- not ("." `isPrefixOf` host)] +-- _ -> [] + -- TODO: process port as an url part + urlParts :: [StringStateParser (String,String,String)] + urlParts = square3 proto (manyCases host) (oneCase query) + where + append xs x = xs ++ [x] + proto :: StringStateParser String + proto = do + masksString <- get + case masksString of + Nothing -> + do + put $ Just $ intercalate protocolsSeparator protocols + return "" --allow to skip proto + Just masksString' -> + do + let masks = split protocolsSeparator masksString' + if null masks + then lift pzero -- no continuations available (parser have finished on previous iteration) + else + do + lift $ skipMany $ char '*' --skip leading * if presented + name <- lift $ many protocolChar + sep <- lift $ many $ oneOf hostSeparators + let chars = name ++ replace "^" "//" sep -- concatenate input and expand separator wildcard + nextChar <- lift $ lookAhead anyChar + let masks' = filterProtoMasks masks chars nextChar -- find possible continuations for current input + if null masks' || null chars + then lift pzero -- fail parser if no continuations or no chars read + else + do + put $ Just $ if isJust (find null masks') -- if empty continuation found (i.e. parser finished) + then "" -- make no continuations available next time + else intercalate protocolsSeparator masks' + return $ if nextChar == '*' then chars ++ "*" else chars + host = try (append <$> many hostChar <*> char '*') <|> + try (append <$> many1 hostChar <*> lookAhead separator) "host" + separator = (oneOf hostSeparators <|> queryEnd) "separator" + query = notFollowedBy (try $ string "//") *> manyTill anyChar (lookAhead (try queryEnd)) "query" + + filterProtoMasks :: [String] -> String -> Char -> [String] + filterProtoMasks masks chars nextChar = mapMaybe filterProtoMask masks + where filterProtoMask mask = if nextChar /= '*' + then if chars `isSuffixOf` mask + then Just "" + else Nothing + else let tailFound = find (chars `isPrefixOf`) (tails mask) + in drop (length chars) <$> tailFound + diff --git a/src/PolicyTree.hs b/src/PolicyTree.hs new file mode 100644 --- /dev/null +++ b/src/PolicyTree.hs @@ -0,0 +1,111 @@ +module PolicyTree ( +NodePolicy (..), +DomainTree (..), +PolicyTree, +restrictionsTree, +mergeTrees, +mergePolicyTrees, +trimTree, +mergeAndTrim, +erasePolicy + +,domainTree +) where +import Control.Applicative +import InputParser hiding (Policy(..)) +import Data.String.Utils (split) +import Utils + +data NodePolicy = None | Block | Unblock deriving (Eq, Show) +data DomainTree a = Node { _name :: String, _value :: a, _children :: [DomainTree a] } +type PolicyTree = DomainTree NodePolicy + +showTree :: Show a => Int -> DomainTree a -> String +showTree lvl (Node name value children) + = concat $ + [replicate (lvl * 2) ' ', "\"", name, "\" - ", (show value)] + ++ (('\n':) <$> showTree (lvl + 1) <$> children) + +instance Show a => Show (DomainTree a) where + show = showTree 0 + +restrictionsTree :: NodePolicy -> Restrictions Domain -> Maybe PolicyTree +restrictionsTree positivePolicy (Restrictions p n) = trimTree positivePolicy <$> mergedTree + where + negativePolicy = case positivePolicy of + Block -> Unblock + _ -> Block + positiveTree = case p of + Nothing -> Just $ Node "" positivePolicy [] + Just p' -> concatTrees positivePolicy $ domainTree positivePolicy <$> p' + negativeTree = concatTrees negativePolicy $ domainTree negativePolicy <$> n + mergedTree = case negativeTree of + Nothing -> positiveTree + Just negativeTree' -> mergePolicyTrees negativePolicy negativeTree' <$> positiveTree + +erasePolicy :: NodePolicy -> PolicyTree -> PolicyTree +erasePolicy policy (Node n p c) = Node n policy' (erasePolicy policy <$> c) + where policy' + | p == policy = None + | otherwise = p + +domainTree :: NodePolicy -> Domain -> PolicyTree +domainTree policy domain = makeTree policy $ ("":) $ reverse $ split "." domain + +makeTree :: NodePolicy -> [String] -> PolicyTree +makeTree _ [] = error "No nodes proviced" +makeTree policy [node] = Node node policy [] +makeTree policy (node:nodes) = Node node None [makeTree policy nodes] + +mergeAndTrim :: NodePolicy -> PolicyTree -> PolicyTree -> PolicyTree +mergeAndTrim trump = trimTree trump .*. mergePolicyTrees trump + +concatTrees :: NodePolicy -> [PolicyTree] -> Maybe PolicyTree +concatTrees _ [] = Nothing +concatTrees _ [tree] = Just tree +concatTrees trump (tree:trees) = mergePolicyTrees trump tree <$> concatTrees trump trees + +mergePolicyTrees :: NodePolicy -> PolicyTree -> PolicyTree -> PolicyTree +mergePolicyTrees trump = mergeTrees mergePolicy + where + mergePolicy policy1 policy2 + | policy1 == None = policy2 + | policy2 == None = policy1 + | policy1 == trump = policy1 + | otherwise = policy2 + +mergeTrees :: (a -> b -> b) -> DomainTree a -> DomainTree b -> DomainTree b +mergeTrees mergeValue t1@(Node name1 value1 children1) t2@(Node name2 value2 children2) + = Node mergeName (mergeValue value1 value2) (mergeChildren children1 children2) + where + -- names expected to be equal and/or empty + mergeName + | name1 == "" = name2 + | otherwise = name1 + + t1Default = t1{_name = "", _children = []} + t2Default = t2{_name = "", _children = []} + + mergeChildren [] [] = [] + mergeChildren (t1Child:t1Children') [] = mergeTrees mergeValue t1Child t2Default : mergeChildren t1Children' [] + mergeChildren [] (t2Child:t2Children') = mergeTrees mergeValue t1Default t2Child : mergeChildren [] t2Children' + mergeChildren t1Children@(t1Child:t1Children') t2Children@(t2Child:t2Children') + | _name t1Child == _name t2Child = mergeTrees mergeValue t1Child t2Child : mergeChildren t1Children' t2Children' + | _name t1Child > _name t2Child = mergeTrees mergeValue t1Child t2Default : mergeChildren t1Children' t2Children + | otherwise = mergeTrees mergeValue t1Default t2Child : mergeChildren t1Children t2Children' + + +trimTree :: NodePolicy -> PolicyTree -> PolicyTree +trimTree trump (Node name policy children) = Node name policy childrenFiltered + where + childrenFiltered = filter (not.redundantChild) childrenTrimmed + childrenTrimmed = trimTree trump <$> children + redundantChild (Node _ childPolicy childChildren) = samePolicy childPolicy && null childChildren + samePolicy childPolicy = childPolicy == policy || (policy == None && childPolicy /= trump) + + + + + + + diff --git a/src/PopupBlocker.hs b/src/PopupBlocker.hs new file mode 100644 --- /dev/null +++ b/src/PopupBlocker.hs @@ -0,0 +1,2 @@ +module PopupBlocker where + diff --git a/src/SourceInfo.hs b/src/SourceInfo.hs new file mode 100644 --- /dev/null +++ b/src/SourceInfo.hs @@ -0,0 +1,68 @@ +module SourceInfo +( +SourceInfo(..), +extractInfo, +showInfo +) where +import InputParser +import Control.Monad.State +import Control.Applicative hiding (many) +import Text.ParserCombinators.Parsec hiding ((<|>),State,Line) +import Data.Time.Clock +import Data.Time.Calendar +import System.Locale +import Data.Time.Format + + +data SourceInfo = SourceInfo { _title, _filename, _license, _homepage :: String, + _lastUpdated :: UTCTime, _expires, _version :: Integer } | NoInfo + +emptySourceInfo :: SourceInfo +emptySourceInfo = SourceInfo "" "" "" "" (UTCTime (ModifiedJulianDay 0) (secondsToDiffTime 0) ) 72 0 + +showInfo :: UTCTime -> SourceInfo -> [String] +showInfo _ NoInfo = ["----- a source skipped -----"] +showInfo now sourceInfo@(SourceInfo _ filename _ _ lastUpdated expires _) = + [concat ["----- source -----"]] + ++ optionalLine "Title: " _title + ++ [concat ["Filename: ", filename], + concat ["Last modified: ", formatTime defaultTimeLocale "%d %b %Y %H:%M %Z" lastUpdated], + concat ["Expires: ", show expires, " hours", expired]] + ++ optionalLine "Version: " _version + ++ optionalLine "License: " _license + ++ optionalLine "Homepage: " _homepage + where + expired | (diffUTCTime now lastUpdated) > (fromInteger $ expires * 60 * 60) = " (expired)" + | otherwise = [] + optionalLine caption getter | getter sourceInfo == getter emptySourceInfo = [] + | otherwise = [concat [caption, show $ getter sourceInfo]] + +extractInfo :: [Line] -> SourceInfo +extractInfo lns@(Line RecordSource{_position = pos} _:_) + = execState (sequence $ lineInfo <$> take 50 lns) initial + where initial =emptySourceInfo { _filename = sourceName pos} +extractInfo _ = NoInfo + +lineInfo :: Line -> State SourceInfo () +lineInfo (Line _ (Comment text)) = do + info <- get + let titleParser = (\x -> info{_title = x}) <$> (string "Title: " *> many1 anyChar) + homepageParser = (\x -> info{_homepage = x}) <$> (string "Homepage: " *> many1 anyChar) + lastUpdatedParser = (\x -> case x of + Just time -> info{_lastUpdated = time} + Nothing -> info) + <$> parseTime defaultTimeLocale "%d %b %Y %H:%M %Z" + <$> (string "Last modified: " *> many1 anyChar) + licenseParser = (\x -> info{_license = x}) + <$> ((string "Licen" <|> string "Лицензия") *> (manyTill anyChar $ char ':') + *> skipMany (char ' ') *> many1 anyChar) + expiresParser = (\n unit -> info{_expires = unit * read n}) + <$> (string "Expires: " *> many1 digit) <*> (24 <$ string " days" <|> 1 <$ string " hours") + versionParser = (\x -> info{_version = read x}) <$> (string "Version: " *> many1 digit) + commentParser = skipMany (char ' ') *> + (try titleParser <|> try expiresParser <|> try versionParser + <|> try licenseParser <|> try homepageParser <|> try lastUpdatedParser) + case parse commentParser "" text of + Left _ -> return () + Right info' -> put info' +lineInfo _ = return () diff --git a/src/Statistics.hs b/src/Statistics.hs new file mode 100644 --- /dev/null +++ b/src/Statistics.hs @@ -0,0 +1,55 @@ +module Statistics where +import qualified Data.Map as Map +import InputParser +import Data.Maybe +import System.IO +import System.FilePath +import Control.Applicative ((<$>)) +import Control.Monad.State + +type Stat = Map.Map String Int + +stat :: String -> [String] -> [Line] -> IO () +stat path info lns = + let result = collectStat lns + filename = path "ab2p.stat" + resultLine (name, value) = concat [name, ": ", show value] + errorLine (Line position (Error text)) + = [concat ["ERROR: ", recordSourceText position, " - ", text]] + errorLine _ = [] + in do + outFile <- openFile filename WriteMode + _ <- mapM (hPutStrLn outFile) info + _ <- sequence $ hPutStrLn outFile . resultLine <$> Map.toAscList result + _ <- sequence $ hPutStrLn outFile <$> (lns >>= errorLine) + hClose outFile + +collectStat :: [Line] -> Stat +collectStat = foldr getStat Map.empty + +increment :: String -> Stat-> Stat +increment key = Map.insertWith (+) key 1 + +isJustFilled :: Maybe [a] -> Bool +isJustFilled Nothing = False +isJustFilled (Just list) = not.null $ list + + +getStat :: Line -> Stat-> Stat +getStat (Line _ Comment {} ) = increment "Comments" +getStat (Line _ Error {}) = increment "Errors" +getStat (Line _ ElementHide {}) = increment "Elements hiding rules" +getStat (Line _ (RequestBlock policy _ (RequestOptions _ thirdParty domains _ _ _ _ _))) = execState stateState + where + incrementState = modify . increment + stateState = do + incrementState "Request block rules total" + when (policy == InputParser.Unblock) $ incrementState "Request block rules for exception" + when (isJust thirdParty) $ incrementState "Rules with third party option" + when ((not.null._negative $ domains) || (isJustFilled . _positive $ domains)) $ incrementState "Request block rules with domain option" + when ((not.null._negative $ domains) || (isJustFilled . _positive $ domains)) $ incrementState "Request block rules with request type options" + + + + + diff --git a/src/Templates.hs b/src/Templates.hs new file mode 100644 --- /dev/null +++ b/src/Templates.hs @@ -0,0 +1,38 @@ +module Templates where +import {-# SOURCE #-} UrlBlocker +import Paths_adblock2privoxy +import System.Directory (copyFile) +import System.FilePath (()) + +blockCss, ab2pPrefix, actionsFilePrefix, filtersFilePrefix :: String +blockCss = "{display:none!important;visibility:hidden!important}" +ab2pPrefix = "ab2p-" +actionsFilePrefix = "#AbBlock generated actions -- don't edit --" +filtersFilePrefix = "#AbBlock generated filters -- don't edit --" + +terminalActionSwitch :: Bool -> BlockMethod -> String +terminalActionSwitch True Request = + "+block{ adblock rules } \\\n\ + \+server-header-tagger{ab2p-block-s}" +terminalActionSwitch False Request = + "-block \\\n\ + \-server-header-tagger{ab2p-block-s} \\\n\ + \+server-header-tagger{ab2p-unblock-d} \\\n\ + \+server-header-tagger{ab2p-unblock-s} \\\n\ + \+client-header-tagger{ab2b-unblock-u}" +terminalActionSwitch True Xframe = "+server-header-filter{ab2p-xframe-filter}" +terminalActionSwitch False Xframe = "-server-header-filter{ab2p-xframe-filter}" +terminalActionSwitch False Elem = "-filter{ab2p-elemhide-filter}" +terminalActionSwitch True Xpopup = "+filter{ab2p-popup-filter}" +terminalActionSwitch False Xpopup = "-filter{ab2p-popup-filter}" +terminalActionSwitch True Dnt = "+add-header{DNT: 1}" +terminalActionSwitch _ _ = "" + +writeTemplateFiles :: String -> IO () +writeTemplateFiles outDir = do + copySystem "ab2p.system.action" + copySystem "ab2p.system.filter" + where + copySystem file = do + dataDir <- getDataDir + copyFile (dataDir "templates" file) (outDir file) diff --git a/src/UrlBlocker.hs b/src/UrlBlocker.hs new file mode 100644 --- /dev/null +++ b/src/UrlBlocker.hs @@ -0,0 +1,264 @@ +module UrlBlocker ( +BlockMethod(..), +TaggerType(..), +urlBlock +) where +import InputParser +import Control.Applicative +import Control.Monad +import Data.List +import Data.Char (toLower) +import Data.Monoid +import OptionsConverter +import Utils +import Control.Monad.State +import qualified Templates +import qualified Data.Map as Map +import Data.String.Utils (split) +import Data.Maybe +import System.IO +import System.FilePath +import PatternConverter + +data TaggerType = Client | Server +data TaggerForwarder = Forward (Maybe Filter) String | CancelTagger String +data Tagger = Tagger { _taggerCode :: String, _forwarding :: [TaggerForwarder], _headerType :: HeaderType } + +data ActionType = TaggerAction Tagger | BlockAction | TerminalAction BlockMethod +data ActionSwitch = Switch Bool ActionType +data Action = Action { _actionCode :: String, _switches :: [ActionSwitch], _patterns :: [Pattern], _hasTag :: Bool } + +data ChainType = Regular | Nested | Negate deriving (Eq, Ord) +type UrlBlockData = ([Tagger], [Action]) +data BlockMethod = Request | Xframe | Elem | Dnt | Xpopup deriving (Show, Eq) +data FilteringNode = Node { _pattern :: [Pattern], _filters :: HeaderFilters, _nodeType :: ChainType, + _policy :: Policy, _method :: BlockMethod } + + +class Named a where + name :: a -> String + +urlBlock :: String -> [String] -> [Line] -> IO() +urlBlock path info = writeBlockData . urlBlockData + where + writeBlockData :: UrlBlockData -> IO() + writeBlockData (taggers, actions) = + do writeContent (path "ab2p.filter") Templates.filtersFilePrefix taggers + writeContent (path "ab2p.action") Templates.actionsFilePrefix actions + writeContent filename header content = + do outFile <- openFile filename WriteMode + hPutStrLn outFile (header) + _ <- mapM (hPutStrLn outFile) $ ('#':) <$> info + hPutStrLn outFile $ intercalate "\n\n" $ show <$> content + hClose outFile + +urlBlockData :: [Line] -> UrlBlockData +urlBlockData lns = filterBlockData $ result + where + result = mconcat [nodeResult node | node <- shortenNodes $ sortBy cmpPolicy $ filterNodesList blockLines] + cmpPolicy node1 node2 = compare (_policy node1) (_policy node2) + blockLines = lns >>= blockLine + where + blockLine (Line position (RequestBlock policy pattern options)) + = filteringNodes policy (errorToPattern expandedPatterns) options + where + expandedPatterns = makePattern (_matchCase options) <<$> parseUrl pattern + sourceText = recordSourceText position + errorToPattern (Left parseError) = ["# ERROR: " ++ sourceText ++ " - " ++ show parseError] + errorToPattern (Right patterns') = ("# " ++ sourceText) : patterns' + blockLine _ = [] + +filterNodesList :: [FilteringNode] -> [FilteringNode] +filterNodesList nodes = Map.foldr (:) [] $ Map.fromListWith joinNodes $ list + where + list = [(name node, node) | node <- nodes] + joinNodes (Node patterns1 filters1 type1 policy1 method1) + (Node patterns2 _ type2 _ _) + = Node (patterns1 ++ patterns2) filters1 (max type1 type2) policy1 method1 + +filterBlockData :: UrlBlockData -> UrlBlockData +filterBlockData blockData = (result, snd blockData) + where + result = Map.foldr (:) [] $ Map.fromListWith joinTaggers taggerItems + taggerItems = [(name tagger, tagger) | tagger <- fst blockData] + metric = length._forwarding + joinTaggers tagger1 tagger2 | metric tagger1 >= metric tagger2 = tagger1 + | otherwise = tagger2 + +shortenNodes :: [FilteringNode] -> [FilteringNode] +shortenNodes nodes = evalState (mapM shortenNode nodes) initialState + where + initialState = Map.empty :: Map.Map String String + shortenNode node = (\f -> node {_filters = f}) <$> ((mapM.mapM) shortenFilter $ _filters node) + shortenFilter headerFilter@(HeaderFilter headerType flt) + = let filterCode = _code flt + in do + dictionary <- get + case Map.lookup filterCode dictionary of + Just shortenCode -> return $ HeaderFilter headerType flt { _code = shortenCode } + Nothing -> case break (=='[') filterCode of + (_,[]) -> return headerFilter + (start, rest) -> + let end = last $ split "]" rest + shortenCode' = start ++ (show $ Map.size dictionary + 1) ++ end + in do put $ Map.insert filterCode shortenCode' dictionary + return $ HeaderFilter headerType flt { _code = shortenCode' } + + +filteringNodes :: Policy -> [Pattern] -> RequestOptions -> [FilteringNode] +filteringNodes policy patterns requestOptions + = join.join $ [mainResult, subdocumentResult, elemhideResult, dntResult, popupResult] + where + mainResult = optionsToNodes mainOptions $> Request + subdocumentResult = maybeToList (optionsToNodes (singleTypeOptions Subdocument) $> Xframe) + elemhideResult = maybeToList (optionsToNodes (boolOptions _elemHide) $> Elem) + dntResult = maybeToList (optionsToNodes (boolOptions _doNotTrack) $> Dnt) + popupResult = maybeToList (optionsToNodes (singleTypeOptions Popup) $> Xpopup) + requestType = _requestType requestOptions + mainOptions = [requestOptions {_requestType = requestType { _positive = mainPosRequestTypes } }] + mainPosRequestTypes = filter (`notElem` [Subdocument]) <$> (_positive requestType) + boolOptions getter = case getter requestOptions of + False -> Nothing + True -> Just requestOptions {_requestType = Restrictions Nothing [], _thirdParty = Nothing} + singleTypeOptions singleType = + do + foundTypes <- filter (== singleType) <$> (_positive requestType) + foundType <- listToMaybe foundTypes + return requestOptions {_requestType = requestType { _positive = Just [foundType] } } + optionsToNodes options = collectNodes patterns <$> headerFilters policy 2 <$> options + nestedOrRegular True = Nested + nestedOrRegular False = Regular + collectNodes :: [Pattern] -> Maybe HeaderFilters -> BlockMethod -> [FilteringNode] + collectNodes _ Nothing _ = [] + collectNodes patterns' (Just []) method = [Node patterns' [] (nestedOrRegular $ null patterns') policy method] + collectNodes patterns' (Just filters@(levelFilters: next)) method + = Node patterns' filters (nestedOrRegular $ null patterns') policy method + : (levelFilters >>= negateNode) + ++ collectNodes [] (Just next) method + where + negateNode negateFilter@(HeaderFilter _ (Filter {_orEmpty = True})) + = [Node [] ([negateFilter] : next) Negate policy method] + negateNode _ = [] + +nodeResult :: FilteringNode -> UrlBlockData +nodeResult node@(Node patterns [] nodeType policy method) = ([], [baseAction]) + where baseAction = Action (name node) [Switch (policy == Block) $ TerminalAction method] patterns (nodeType == Nested) +nodeResult node@(Node _ ([flt] : nextLevelFilters) Negate policy method) + = ([negateTagger], [negateAction]) + where + negateAction = Action (name node) [Switch False $ TaggerAction negateTagger] [] True + negateTagger = newTagger flt nextLevelFilters policy method Negate [] +nodeResult node@(Node patterns (levelFilters : nextLevelFilters) nodeType policy method) + = (taggers, [action]) + where + action = Action { _actionCode = name node, + _switches = appendIf (policy == Unblock && method == Request) + (Switch False BlockAction) + (Switch True . TaggerAction <$> taggers), + _patterns = patterns, + _hasTag = (nodeType == Nested) } + taggers = filterTaggers <$> levelFilters + filterTaggers flt@(HeaderFilter _ (Filter _ _ orEmpty)) + = newTagger flt nextLevelFilters policy method Regular moreForwarding + where + orEmptyTaggerCode = filtersCode ([flt] : nextLevelFilters) Negate policy method "" + moreForwarding | orEmpty = [CancelTagger orEmptyTaggerCode] + | otherwise = [] + +newTagger :: HeaderFilter -> HeaderFilters -> Policy -> BlockMethod -> ChainType -> [TaggerForwarder] -> Tagger +newTagger flt@(HeaderFilter headerType filter') nextLevelFilters policy method chainType moreForwarding + = Tagger { _taggerCode = taggerCode, + _forwarding = Forward filter'' nextLevelActionCode : moreForwarding, + _headerType = headerType } + where + filter'' | chainType == Negate = Nothing + | otherwise = Just filter' + taggerCode = filtersCode ([flt] : nextLevelFilters) chainType policy method "" + nextLevelActionCode = filtersCode nextLevelFilters Nested policy method "" + +instance Named FilteringNode where + name (Node _ filters Negate policy method) = '-' : filtersCode filters Negate policy method "" + name (Node _ filters _ policy method) = filtersCode filters Nested policy method "" + +filtersCode :: HeaderFilters -> ChainType -> Policy -> BlockMethod -> String -> String +filtersCode [] _ policy method rest + = join [Templates.ab2pPrefix, toLower <$> show policy, "-" ,toLower <$> show method,(if null rest then "" else "-"), rest] +filtersCode (levelFilters : nextLevelFilters) chainType policy method rest + = filtersCode nextLevelFilters Nested policy method $ join [levelCode, (if null rest then "" else "-when-"), rest] + where + levelCode = (intercalate "-" $ filterCode <$> levelFilters) + filterCode (HeaderFilter HeaderType {_typeCode = typeCode} (Filter code _ orEmpty)) + | chainType == Negate = negateCode + | chainType == Nested && orEmpty = negateCode ++ '-' : mainCode + | otherwise = mainCode + where + mainCode = typeCode : code + negateCode = 'n' : [typeCode] + +instance Show TaggerType where + show Client = "CLIENT-HEADER-TAGGER" + show Server = "SERVER-HEADER-TAGGER" + +instance Named TaggerType where + name = fmap toLower . show + +instance Named Tagger where + name = _taggerCode + +instance Show Tagger where + show (Tagger code forwarding HeaderType {_name = headerName, _taggerType = taggerType }) + = intercalate "\n" (caption : (forward <$> forwarding)) + where caption = show taggerType ++ (':' : ' ' : code) + forward (Forward (Just filter') tagret) = forwardRegex headerName (_regex filter') ":" "" tagret + forward (Forward Nothing tagret) = forwardRegex "" "" "" "" tagret + forward (CancelTagger taggerCode) = forwardRegex headerName "" ":" "-" taggerCode + forwardRegex header expression value tagPrefix tagret + = let (modifier, lookahead' : additionalLines) + | '\n' `elem` expression = ("i", split "\n" expression) -- the case for third-party + | otherwise = ("Ti", [expression]) + in intercalate "\n" $ additionalLines ++ + [join ["s@^", header, lookahead', value, ".*@", tagPrefix, tagret, "@", modifier]] + +instance Named Bool where + name True = "+" + name False = "-" + +instance Show ActionSwitch where + show (Switch enable (TerminalAction method)) = Templates.terminalActionSwitch enable method + show (Switch enable BlockAction) = name enable ++ "block" + show (Switch enable (TaggerAction tagger)) + = intercalate " \\\n " $ mainText : (_forwarding tagger >>= cancelTaggerText) + where + mainText = join [name enable, name $ _taggerType $ _headerType $ tagger, "{", name tagger, "}" ] + cancelTaggerText (CancelTagger cancelTaggerCode) + = [join [name enable, name $ _taggerType $ _headerType $ tagger, "{", cancelTaggerCode, "}" ]] + cancelTaggerText _ = [] + +instance Named Action where + name = _actionCode + +instance Show Action where + show (Action code switches patterns hasTag) + = intercalate "\n" (caption : switches' : patterns') + where caption = '#' : code + switches' = join ["{", intercalate " \\\n " (show <$> switches), " \\\n}"] + patterns' | hasTag = join ["TAG:^", code, "$"] : patterns + | otherwise = patterns + + + + + + + + + + + + + + + + + + diff --git a/src/UrlBlocker.hs-boot b/src/UrlBlocker.hs-boot new file mode 100644 --- /dev/null +++ b/src/UrlBlocker.hs-boot @@ -0,0 +1,7 @@ +module UrlBlocker ( +BlockMethod(..), +TaggerType(..) +) where + +data BlockMethod = Request | Xframe | Elem | Dnt | Xpopup +data TaggerType = Client | Server diff --git a/src/Utils.hs b/src/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Utils.hs @@ -0,0 +1,173 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Utils ( +Struct2 (..), +Struct3 (..), +Struct4 (..), +Struct5 (..), +testSquare, +ZipListM, +getZipListM, +zipListM, +maxList, +minList, +compareList, +appendIf, +pure', +pure'', +(<<$>), +(<<<$>), +(<<*>>), +(<<<*>>>), +($>), +($>>), +($>>>), +(.*.) +) where +import Control.Applicative hiding (many) +import Control.Monad.Writer +import Control.Monad.State + +------------------------------------------------------------------------------------------ +----------------------------- export ----------------------------------------------------- +------------------------------------------------------------------------------------------ + +-- at least one list should be finite +compareList :: Ord a => [a] -> [a] -> Ordering +compareList = compareList' EQ + where + compareList' lx [] [] = lx + compareList' _ [] _ = LT + compareList' _ _ [] = GT + compareList' lx (x:xs) (y:ys) = compareList' (lx <> compare x y) xs ys + +maxList :: Ord a => [a] -> [a] -> [a] +maxList a b = if compareList a b == LT then b else a + +minList :: Ord a => [a] -> [a] -> [a] +minList a b = if compareList a b == GT then b else a + +appendIf :: Bool -> a -> [a] -> [a] +appendIf condition item list + | condition = item : list + | otherwise = list + +newtype ZipListM a = ZipListM { getZipList' :: ZipList a } deriving (Functor, Applicative) +getZipListM :: ZipListM a -> [a] +getZipListM = getZipList.getZipList' + +zipListM :: [a] -> ZipListM a +zipListM = ZipListM . ZipList + +instance Monoid a => Monoid (ZipListM a) where + mempty = pure mempty + mappend x y = mappend <$> x <*> y + +class Struct2 f where + struct2 :: a1 -> a2 -> f a1 a2 + square2 :: (Applicative g, Monoid a1, Monoid a2) => g a1 -> g a2 -> [g (f a1 a2)] + square2 a1 a2 = makeSquare (pure'' struct2 <%> a1 <%> a2) + + +class Struct3 f where + struct3 :: a1 -> a2 -> a3 -> f a1 a2 a3 + square3 :: (Applicative g, Monoid a1, Monoid a2, Monoid a3) => + g a1 -> g a2 -> g a3 -> [g (f a1 a2 a3)] + square3 a1 a2 a3 = makeSquare (pure'' struct3 <%> a1 <%> a2 <%> a3) + +class Struct4 f where + struct4 :: a1 -> a2 -> a3 -> a4 -> f a1 a2 a3 a4 + square4 :: (Applicative g, Monoid a1, Monoid a2, Monoid a3, Monoid a4) => + g a1 -> g a2 -> g a3 -> g a4 -> [g (f a1 a2 a3 a4)] + square4 a1 a2 a3 a4 = makeSquare (pure'' struct4 <%> a1 <%> a2 <%> a3 <%> a4) + +class Struct5 f where + struct5 :: a1 -> a2 -> a3 -> a4 -> a5 -> f a1 a2 a3 a4 a5 + square5 :: (Applicative g, Monoid a1, Monoid a2, Monoid a3, Monoid a4, Monoid a5) => + g a1 -> g a2 -> g a3 -> g a4 -> g a5 -> [g (f a1 a2 a3 a4 a5)] + square5 a1 a2 a3 a4 a5 = makeSquare (pure'' struct5 <%> a1 <%> a2 <%> a3 <%> a4 <%> a5) + +instance Struct2 (,) where struct2 = (,) +instance Struct3 (,,) where struct3 = (,,) +instance Struct4 (,,,) where struct4 = (,,,) +instance Struct5 (,,,,) where struct5 = (,,,,) + + +--------------------------------------------------------------------------------------------- +------------------------- usage sample ------------------------------------------------------ +--------------------------------------------------------------------------------------------- + +----- result is -------- +-- [Just ( "a", 0 , False ), +-- Just ( "" , 1, False ), +-- Just ( "" , 0 , True )] +------------------------- +testSquare :: [Maybe (String, Sum Int, Any)] +testSquare = square3 (Just "a") (Just (Sum $ length "")) (Just (Any True)) + +----------------------------------------------------------------------------------------------- +------------------------- implementation ------------------------------------------------------ +----------------------------------------------------------------------------------------------- + +-- wraps value to have something meaningfull only on diagonal places in a matrix like +-- [(V,m), +-- (m,V)] +-- where V is for value, m is for mempty +-- involves 2 applicatives/monads : +-- State Int a - stores column number +-- Reader ((->) r) - provides row number from outside +valueOnDiagonal :: (Applicative f, Monoid a) => f a -> State Int (Int -> f a) +valueOnDiagonal val = do + col <- get + put (col + 1) + return (\row -> if row == col + then val + else pure mempty) + +-- lifts right argument 2 levels up to become s (r (f a)) where s = State and r = Reader +-- then applies left arg to right one +-- it's used to put items to a line in matrix +(<%>) :: (Applicative f, Monoid a) => State Int (Int -> f (a -> b)) + -> f a -- becomes State Int (Int -> f a) after lift with valueOnDiagonal + -> State Int (Int -> f b) +(<%>) a b = a <<<*>>> valueOnDiagonal b + +-- creates square matrix from given lines +-- values are on main diagonal +makeSquare :: State Int (Int -> a) -> [a] +makeSquare line = let start = 0 + (line', size) = runState line start + in line' <$> [start .. size - 1] + +-- pure level 2 +pure' :: (Applicative f, Applicative g) => a -> f (g a) +pure' = pure.pure + +-- pure level 3 +pure'' :: (Applicative f, Applicative g, Applicative h) => a -> f (g (h a)) +pure'' = pure.pure.pure + +infixl 4 .*., <<$>, <<<$>, $>, $>>, $>>>, <<*>>, <<<*>>> + +(.*.) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d) +(.*.) = (.).(.) + +(<<$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b) +(<<$>) = fmap.fmap + +(<<<$>) :: (Functor f, Functor g, Functor h) => (a -> b) -> f (g (h a)) -> f (g (h b)) +(<<<$>) = fmap.fmap.fmap + +($>) :: (Applicative f) => f (a -> b) -> a -> f b +($>) a b = a <*> pure b + +($>>) :: (Applicative f, Applicative g) => f (g (a -> b)) -> a -> f (g b) +($>>) a b = a <<*>> pure' b + +($>>>) :: (Applicative f, Applicative g, Applicative h) => f (g (h (a -> b))) -> a -> f (g (h b)) +($>>>) a b = a <<<*>>> pure'' b + +(<<*>>) :: (Applicative f, Applicative g) => f (g (a -> b)) -> f (g a) -> f (g b) +(<<*>>) = liftA2 (<*>) + +(<<<*>>>) :: (Applicative f, Applicative g, Applicative h) => f (g (h (a -> b))) -> f (g (h a)) -> f (g (h b)) +(<<<*>>>) = liftA2 (<<*>>) diff --git a/templates/ab2p.system.action b/templates/ab2p.system.action new file mode 100644 --- /dev/null +++ b/templates/ab2p.system.action @@ -0,0 +1,32 @@ +#AbBlock system actions -- don't edit -- + +{+set-image-blocker{blank} \ + +filter{ab2p-elemhide-filter} \ + +client-header-tagger{ab2p-elemhide-check-debug} \ + +client-header-tagger{ab2p-handle-as-image-c} \ + +server-header-tagger{ab2p-handle-as-image-s}} +/ + +{-filter{ab2p-elemhide-filter} \ + +filter{ab2p-elemhide-filter-debug}} +TAG:^ab2p-elemhide-filter-debug$ + +{+handle-as-image} +TAG:^ab2p-handle-as-image$ + +{+block{ adblock rules }} +TAG:^ab2p-block-s$ + +{-block} +TAG:^ab2p-unblock-u$ + +{-block} +TAG:^ab2p-unblock-d$ + +{-block} +TAG:^ab2p-unblock-s$ + +#workaround for gzip handling privoxy bugs +{ +prevent-compression } + *.yahoo.com + *.amazon.com diff --git a/templates/ab2p.system.filter b/templates/ab2p.system.filter new file mode 100644 --- /dev/null +++ b/templates/ab2p.system.filter @@ -0,0 +1,39 @@ +#AbBlock system filters -- don't edit -- + + +SERVER-HEADER-TAGGER: ab2p-block-s +s@.*@ab2p-block-s@Ti + + +CLIENT-HEADER-TAGGER: ab2b-unblock-u +s@user-agent.*@ab2p-unblock-u@Ti + +SERVER-HEADER-TAGGER: ab2p-unblock-d +s@date.*@ab2p-unblock-d@Ti + +SERVER-HEADER-TAGGER: ab2p-unblock-s +s@server.*@ab2p-unblock-s@Ti + + +SERVER-HEADER-TAGGER: ab2p-handle-as-image-s +s@^content-type(?=:[\s\w]*image\/):.*@ab2p-handle-as-image@Ti + +CLIENT-HEADER-TAGGER: ab2p-handle-as-image-c +s@^accept(?=:[\s\w]*image\/):.*@ab2p-handle-as-image@Ti + +SERVER-HEADER-FILTER: ab2p-xframe-filter +s@.*\sHTTP\/1.*@$&\r\nX-Frame-Options: DENY@i + +CLIENT-HEADER-TAGGER: ab2p-elemhide-check-debug +s@^cookie:.*ab2p-elemhide-filter-debug=true(?:;|$).*@ab2p-elemhide-filter-debug@Ti + +FILTER: ab2p-elemhide-filter +s@[^'"\s]\s*]*>(?=\s*[^'"\s])@$&@iUD + +FILTER: ab2p-elemhide-filter-debug +s@[^'"\s]\s*]*>(?=\s*[^'"\s])@$&@iUD + +FILTER: ab2p-popup-filter +s@[^'"\s]\s*]*>(?=\s*[^'"\s])@$&@iUD + +