├── .gitignore ├── CONTRIBUTING.md ├── Changes ├── LICENSE ├── PiFlash.spec ├── README.md ├── bin └── piflash ├── dist.ini ├── doc ├── raspberrypi_board_vector_red.png └── resources.pod ├── lib ├── PiFlash.pm └── PiFlash │ ├── Command.pm │ ├── Hook.pm │ ├── Inspector.pm │ ├── MediaWriter.pm │ ├── Object.pm │ ├── Plugin.pm │ └── State.pm ├── perlcritic.rc ├── perltidy.rc └── t ├── 000_platform.t ├── 001_module_load.t ├── 010_PiFlash_State.t ├── 011_PiFlash_Command.t ├── 020_config_yaml.t ├── 021_plugin.t ├── 022_cmdline.t └── test-inputs ├── 020_config_yaml ├── 000-test-metadata.yml ├── 001-simple.yml ├── 002-dup-yaml.yml ├── 003-multi-doc.yml ├── 004-scalar.yml ├── 005-toc.yml ├── 006-toc.yml ├── 007-toc.yml ├── 008-toc.yml └── 009-toc.yml ├── 021_plugin ├── 000-no-docs.yml └── 001-multi-doc.yml └── 022_cmdline └── a_file_that_exists /.gitignore: -------------------------------------------------------------------------------- 1 | /PiFlash-* 2 | /.build 3 | !META.json 4 | 5 | *.pm.tdy 6 | *.swp 7 | 8 | # Dizt::Zilla 9 | /.build/ 10 | PiFlash-[0-9]*.tar.gz 11 | PiFlash-[0-9]*/ 12 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing to PiFlash 2 | 3 | Thanks for contributing to PiFlash! Here are some quick guidelines. 4 | 5 | Generally, if you are reporting a problem or offering a suggestion, open an issue. If you have a patch to the code, 6 | submit a pull request. Choose one or the other - it is not necessary to submit an issue for the same thing as a 7 | pull request. 8 | 9 | ## Code of conduct 10 | 11 | To set expectations for how volunteers work together on this project, 12 | the [Contributor Covenant v1.4](https://www.contributor-covenant.org/version/1/4/code-of-conduct) 13 | was selected. 14 | This expectation applies both ways, how you should treat others and what you may expect from others. 15 | It should be used as a gentle reminder to contributors or developers as needed. 16 | 17 | In general, this works better when people are stricter on themselves and try to be more accepting of others. 18 | Each of us has different styles, which also means we can bring different strengths to the project. 19 | Anyone in a leadership role should try to bring out the best in the team. 20 | 21 | The point of a code of conduct in an Open Source software project is to avoid an unstructured environment where 22 | the last loud bully standing always wins, often after they've caused others to give up and go away. 23 | Like it or not, that's human nature - if you allow it by having no standards of behavior, someone *will* do that. 24 | Even before the Internet, this trend was documented in the 1970s in 25 | "[The Tyranny of Structurelessness](https://en.wikipedia.org/wiki/The_Tyranny_of_Structurelessness)". 26 | It is not a new problem. 27 | 28 | ## Submitting an issue 29 | 30 | If you're having a problem with PiFlash, try to describe enough so it will be possible for others to understand 31 | what the problem is, and how to duplicate it on their systems. For example, show what happened and tell how that 32 | differs from what you expected to happen. A description of your system hardware is helpful, 33 | and that can be accomplished by attaching a file with the output of PiFlash's --verbose flag. Be sure to look 34 | through the verbose output and remove any private info that you don't want posted in public. It's helpful to know 35 | where something was removed - a good way to communicate that is to replace removed text with the string "[redacted]". 36 | 37 | New issues can be submitted at https://github.com/ikluft/piflash/issues 38 | 39 | Be ready to answer questions about the issue if necessary. 40 | 41 | ## Submitting a Pull Request 42 | 43 | Generally the idea behind a pull request is to fork the repository, make your changes in a branch named to 44 | describe the changes, and submit it to the project. Be sure to describe the purpose of the change first. 45 | If anything is obscure about the change, explain it. 46 | Before it can be accepted, it will be reviewed. 47 | Any description, documentation and tests necessary for that may help speed it along. 48 | 49 | GitHub has help on creating pull requerts at https://help.github.com/articles/creating-a-pull-request/ 50 | 51 | New pull requests can be submitted at https://github.com/ikluft/piflash/pulls 52 | 53 | Be ready to answer questions about the pull request if necessary. 54 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Change log for PiFlash 2 | 3 | {{$NEXT}} 4 | [API CHANGE] 5 | 6 | [BUG FIXES] 7 | - code cleanup based on results of Perl::Critic scans 8 | 9 | [DOCS] 10 | - resources.pod updates 11 | 12 | [ENHANCEMENTS] 13 | - add support for BTRFS filesystem which is now used by Fedora 14 | 15 | [MAJOR] 16 | 17 | [MINOR] 18 | - convert PiFlash::State from a static structure to a singleton class instance (part of Perl::Critic cleanup) 19 | 20 | [REVISION] 21 | 22 | [SECURITY] 23 | 24 | 0.4.3 2019-03-23T10:35:14-07:00 America/Los_Angeles 25 | [DOCS] 26 | - fix RPM spec error (no files matched doc/*.md) that broke 0.4.2 before 27 | GitHub release but after CPAN upload 28 | 29 | 0.4.2 2019-03-23T10:25:51Z America/Los_Angeles 30 | [DOCS] 31 | - convert doc/resources.md back to POD so MetaCPAN will display it as 32 | documentation on the release page 33 | - declare doc/*.md & doc/*.pod as documentation files in the RPM spec 34 | 35 | 0.4.1 2019-03-21T16:46:28-07:00 America/Los_Angeles 36 | [BUG FIXES] 37 | - the --help option is the only case of printing usage info which 38 | shouldn't have an error message 39 | 40 | [DOCS] 41 | - add /doc directory starting with new file of online resource list 42 | - add links in POD docs to the online resources on GitHub 43 | - change README.md to be a top-level intro instead of a markdown copy of 44 | the pod docs in bin/piflash 45 | 46 | [REVISION] 47 | - added more command-line tests in t/022_cmdline.t 48 | - added more YAML test files for cases of 1 or 2 attachments for the 3 49 | test plugins 50 | 51 | 0.4.0 2019-03-18T20:40:50-07:00 America/Los_Angeles 52 | [BUG FIXES] 53 | - when displaying program usage, display the reason the program can't run 54 | 55 | [DOCS] 56 | - POD formatting fixes - text in PiFlash::Object and PiFlash::Plugin 57 | should not have been a block (indented) 58 | 59 | [MINOR] 60 | - reorg PiFlash::State accessor functions to use top-level parameter 61 | containers from a class method instead of what was running in the 62 | closure at init time 63 | - add t/022_cmdline.t with 32 test cases for command line option 64 | processing 65 | 66 | 0.3.1 2019-03-13T01:19:06-07:00 America/Los_Angeles 67 | [BUG FIXES] 68 | - remove README from RPM spec file, which blocked Dist::Zilla from 0.3.0 69 | release to GitHub after upload to CPAN 70 | 71 | 0.3.0 2019-03-13T00:59:24Z America/Los_Angeles 72 | [DOCS] 73 | - remove 2nd automatic generation of README from POD in bin/piflash - it's 74 | redundant with README.md needed for GitHub 75 | - add plugin documentation in new PiFlash::Plugin module 76 | 77 | [MINOR] 78 | - move plugin code to new PiFlash::Plugin module 79 | - add PiFlash::Object to provide a common new() which came from 80 | PiFlash::Hook but is also needed for PiFlash::Plugin 81 | 82 | [REVISION] 83 | - Dist::Zilla configuration - move git plugins before @Basic plugins as 84 | recommended in docs 85 | - expand unit tests for PiFlash::State and PiFlash::Command 86 | - expand unit tests for plugins 87 | 88 | 0.2.2 2019-03-07T17:24:45-08:00 America/Los_Angeles 89 | [DOCS] 90 | - remove automatic generation of README from POD in bin/piflash - it's 91 | redundant with README.md needed for GitHub 92 | 93 | [REVISION] 94 | - lower Perl version requirement from 5.18 (2013) to 5.14 (2011) to match 95 | the era of the Raspberry Pi 96 | - add logging mode to clean up test output - log command results without 97 | verbose output 98 | 99 | 0.2.1 2019-03-07T03:46:40-08:00 America/Los_Angeles 100 | [BUG FIXES] 101 | - fix non-portable symbol table insertion which was causing segfault in 102 | can_ok test on Perl 5.24 103 | - fix name of environment variable to override program path when program 104 | name contains a hyphen 105 | - fix test for PiFlash::Command not to use hard-coded /usr/bin/true - that 106 | was only succeeding on RedHat/Fedora 107 | 108 | [REVISION] 109 | - reorg tests for PiFlash::Command so it can compute number of tests 110 | 111 | 0.2.0 2019-03-03T22:56:17-08:00 America/Los_Angeles 112 | [BUG FIXES] 113 | - require Linux platform to build or test, in response to reports of 114 | automated tests failing on unsupported FreeBSD 115 | 116 | [MINOR] 117 | - change Dist::Zilla configuration to use ModuleBuild instead of 118 | ExtUtils::MakeMaker 119 | 120 | 0.1.0 2019-02-28T11:45:04-08:00 America/Los_Angeles 121 | [DOCS] 122 | - Updated installation package dependencies for RPM & DEB systems 123 | 124 | [ENHANCEMENTS] 125 | - Added YAML config files 126 | - Added plugin modules and PiFlash::Hook 127 | 128 | 0.0.6 2019-02-05T19:11:47-08:00 America/Los_Angeles 129 | - tweaks to RPM spec for release 130 | 131 | 0.0.5 2019-02-05T19:00:00-08:00 America/Los_Angeles 132 | - add filesystem resize, including --resize added to command line 133 | - add --version to command line 134 | - fixed PiFlash::Inspector SD search which needed to chomp CR's off of 135 | string read from /sys 136 | - PiFlash::Hook added 137 | - cleanups: minor docs tweaks, add blank lines for Dist::Zilla to add 138 | VERSION to modules 139 | - abandon use of Dist::Zilla's plugins for RPM & Deb package generation on 140 | release for now 141 | 142 | 0.0.4 2018-10-14T00:00:00-00:00 UTC 143 | - experiment with automatic generation of RPM and Debian Dpkg files on 144 | release 145 | 146 | 0.0.3 2018-10-11T16:47:42-07:00 America/Los_Angeles 147 | - update installation instructions to reflect piflash's move on GitHub 148 | from ikluft-tools to new piflash repo 149 | - add CONTRIBUTING.md for instructions on contributing to the project 150 | 151 | 0.0.2 2018-10-11T13:18:36-07:00 America/Los_Angeles 152 | - split 1000+ line piflash script into modules: PiFlash, PiFlash::Command, 153 | PiFlash::Inspector, PiFlash::State 154 | - add test directory and basic tests 155 | - add build/PiFlash.spec for building RPM packages - piflash script uses 156 | the modules, user doesn't need to know Perl 157 | 158 | 0.0.1 2017-03-15T00:00:00-00:00 UTC 159 | - release piflash script with "Using Perl on the Raspberry Pi" article by 160 | Ian Kluft on OpenSource.com 161 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | 176 | END OF TERMS AND CONDITIONS 177 | 178 | APPENDIX: How to apply the Apache License to your work. 179 | 180 | To apply the Apache License to your work, attach the following 181 | boilerplate notice, with the fields enclosed by brackets "[]" 182 | replaced with your own identifying information. (Don't include 183 | the brackets!) The text should be enclosed in the appropriate 184 | comment syntax for the file format. We also recommend that a 185 | file or class name and description of purpose be included on the 186 | same "printed page" as the copyright notice for easier 187 | identification within third-party archives. 188 | 189 | Copyright [yyyy] [name of copyright owner] 190 | 191 | Licensed under the Apache License, Version 2.0 (the "License"); 192 | you may not use this file except in compliance with the License. 193 | You may obtain a copy of the License at 194 | 195 | http://www.apache.org/licenses/LICENSE-2.0 196 | 197 | Unless required by applicable law or agreed to in writing, software 198 | distributed under the License is distributed on an "AS IS" BASIS, 199 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 200 | See the License for the specific language governing permissions and 201 | limitations under the License. 202 | -------------------------------------------------------------------------------- /PiFlash.spec: -------------------------------------------------------------------------------- 1 | Name: <% $zilla->name %> 2 | Version: <% (my $v = $zilla->version) =~ s/^v//; $v %> 3 | Release: 1%{?dist} 4 | Summary: <% $zilla->abstract %> 5 | License: Apache Software License 6 | BuildArch: noarch 7 | URL: <% $zilla->license->url %> 8 | Source: <% $archive %> 9 | 10 | BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n) 11 | 12 | BuildRequires: perl-interpreter >= 1:v5.18.0 13 | BuildRequires: perl(autodie) 14 | BuildRequires: perl(Carp) 15 | BuildRequires: perl(ExtUtils::MakeMaker) 16 | BuildRequires: perl(File::Basename) 17 | BuildRequires: perl(File::LibMagic) 18 | BuildRequires: perl(File::Slurp) 19 | BuildRequires: perl(Getopt::Long) 20 | BuildRequires: perl(IO::Handle) 21 | BuildRequires: perl(IO::Poll) 22 | BuildRequires: perl(POSIX) 23 | BuildRequires: perl(Test::More) 24 | Requires: perl(autodie) 25 | Requires: perl(Carp) 26 | Requires: perl(Exception::Class) 27 | Requires: perl(File::Basename) 28 | Requires: perl(File::LibMagic) 29 | Requires: perl(File::Path) 30 | Requires: perl(File::Slurp) 31 | Requires: perl(Getopt::Long) 32 | Requires: perl(IO::Handle) 33 | Requires: perl(IO::Poll) 34 | Requires: perl(Module::Pluggable) 35 | Requires: perl(POSIX) 36 | Requires: perl(Try::Tiny) 37 | Requires: perl(YAML::LibYAML) 38 | Requires: perl(:MODULE_COMPAT_%(eval "`%{__perl} -V:version`"; echo $version)) 39 | 40 | %{?perl_default_filter} 41 | 42 | %description 43 | <% $zilla->abstract %> 44 | 45 | %prep 46 | %setup -q 47 | 48 | %build 49 | %{__perl} Makefile.PL INSTALLDIRS=vendor 50 | [ -d %{perl_vendorlib} ] || mkdir -p %{perl_vendorlib} 51 | [ -d %{_mandir} ] || mkdir -p %{_mandir} 52 | make %{?_smp_mflags} 53 | 54 | %install 55 | [ "$RPM_BUILD_ROOT" != "/" ] && rm -rf $RPM_BUILD_ROOT 56 | make pure_install DESTDIR=$RPM_BUILD_ROOT 57 | find $RPM_BUILD_ROOT -type f \( -name .packlist -o -name perllocal.pod -o -name dist.ini \) -exec rm -f {} \; 58 | find $RPM_BUILD_ROOT -depth -type d -exec rmdir {} 2>/dev/null \; 59 | %{_fixperms} $RPM_BUILD_ROOT/* 60 | 61 | %check 62 | make test 63 | 64 | %clean 65 | [ "$RPM_BUILD_ROOT" != "/" ] && rm -rf $RPM_BUILD_ROOT 66 | 67 | %files 68 | %defattr(-,root,root,-) 69 | %doc Changes dist.ini LICENSE META.json README.md CONTRIBUTING.md doc/*.pod 70 | %{perl_vendorlib}/* 71 | %{_mandir}/man3/*.3* 72 | %{_mandir}/man1/*.1* 73 | %{_bindir}/* 74 | 75 | %changelog 76 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Name 2 | 3 | *piflash* - Raspberry Pi SD-flashing script with safety checks to avoid erasing the wrong device 4 | 5 | # Synopsis 6 | 7 | piflash [--verbose] [--resize] [--config conf-file] input-file output-device 8 | 9 | piflash [--verbose] --sdsearch 10 | 11 | piflash --version 12 | 13 | # Featured article 14 | 15 | 16 | 17 | "Getting started with PiFlash: Booting your Raspberry Pi on Linux" 18 | 19 |
20 | by Ian Kluft at OpenSource.com 21 |
22 | March 15, 2019 23 |
24 | 25 | # Description 26 | 27 | PiFlash writes (or "flashes") an SD card for a Raspberry Pi. It includes safety checks so that it can only erase and write to an SD card, not another device on the system. The safety checks are probably of most use to beginners. For more advanced users (like the author) it also has the convenience of flashing directly from the file formats downloadable from raspberrypi.org without extracting a .img file from a zip/gz/xz file. 28 | 29 | ## User documentation 30 | 31 | * [PiFlash program usage and installation](https://metacpan.org/pod/distribution/PiFlash/bin/piflash) 32 | * [Online resources for PiFlash](https://metacpan.org/pod/distribution/PiFlash/doc/resources.pod) 33 | * [Where to download Raspberry Pi bootable images](https://metacpan.org/pod/distribution/PiFlash/doc/resources.pod#Where-to-download-Raspberry-Pi-bootable-images) 34 | * [Presentations and Articles](https://metacpan.org/pod/distribution/PiFlash/doc/resources.pod#Presentations-and-Articles) 35 | * [PiFlash release on CPAN](https://metacpan.org/release/PiFlash) 36 | * [PiFlash source code on GitHub](https://github.com/ikluft/piflash) 37 | 38 | PiFlash documentation is available as Unix man-pages and as Perl POD (Plain Old Documentation). 39 | Once installed, you can run `man` or `perldoc` from a shell to read the documentation: 40 | 41 | % man piflash 42 | 43 | or 44 | 45 | % perldoc piflash 46 | 47 | ## Developer documentation 48 | 49 | * [PiFlash](https://metacpan.org/pod/PiFlash) - Raspberry Pi SD-flashing script with safety checks to avoid erasing the wrong device 50 | * [PiFlash::Command](https://metacpan.org/pod/PiFlash::Command) - process/command running utilities for piflash 51 | * [PiFlash::Hook](https://metacpan.org/pod/PiFlash::Hook) - named dispatch/hook library for PiFlash 52 | * [PiFlash::Inspector](https://metacpan.org/pod/PiFlash::Inspector) - PiFlash functions to inspect Linux system devices to flash an SD card for Raspberry Pi 53 | * [PiFlash::MediaWriter](https://metacpan.org/pod/PiFlash::MediaWriter) - write to Raspberry Pi SD card installation with scriptable customization 54 | * [PiFlash::Object](https://metacpan.org/pod/PiFlash::Object) - object functions for PiFlash classes 55 | * [PiFlash::Plugin](https://metacpan.org/pod/PiFlash::Plugin) - plugin extension interface for PiFlash 56 | * [PiFlash::State](https://metacpan.org/pod/PiFlash::State) - PiFlash::State class to store configuration, device info and program state 57 | 58 | ## Participation in PiFlash 59 | 60 | See the [Contributing to PiFlash](CONTRIBUTING.md) docs. 61 | 62 | * [Code of Conduct](CONTRIBUTING.md#code-of-conduct) 63 | * [Submitting an issue](CONTRIBUTING.md#submitting-an-issue) 64 | * [Submitting a Pull Request](CONTRIBUTING.md#submitting-a-pull-request) 65 | 66 | When reporting a bug, please include the full output using the --verbose option. That will include all of the 67 | program's state information, which will help understand the bigger picture what was happening on your system. 68 | Feel free to remove information you don't want to post in a publicly-visible bug report - though it's helpful 69 | to add "[redacted]" where you removed something so it's clear what happened. 70 | 71 | For any SD card reader hardware which piflash fails to recognize (and therefore refuses to write to), 72 | please describe the hardware as best you can including name, product number, bus (USB, PCI, etc), 73 | any known controller chips. 74 | -------------------------------------------------------------------------------- /bin/piflash: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # piflash - flash a Raspberry Pi image to an SD card, with safety checks to avoid erasing wrong device 3 | # by Ian Kluft 4 | use strict; 5 | use warnings; 6 | use 5.01400; # require 2011 or newer version of Perl 7 | use autodie; # report errors instead of silently continuing ("die" actions are used as exceptions - caught & reported) 8 | use PiFlash; 9 | 10 | # PODNAME: piflash 11 | # ABSTRACT: Raspberry Pi SD-flashing script with safety checks to avoid erasing the wrong device 12 | 13 | =head1 USAGE 14 | 15 | piflash [--verbose] [--resize] [--config conf-file] input-file output-device 16 | 17 | piflash [--verbose] [--config conf-file] --sdsearch 18 | 19 | piflash --version 20 | 21 | =head1 DESCRIPTION 22 | 23 | The "piflash" program writes (or "flashes") an SD card for a Raspberry Pi single-board computer. It includes safety checks so that it can only erase and write to an SD card, not another device on the system. The safety checks are probably of most use to beginners. For more advanced users (like the author, which is why this was written) it also has the convenience of flashing directly from the file formats downloadable from raspberrypi.org without extracting a .img file from a zip/gz/xz file. 24 | 25 | =over 1 26 | 27 | =item * 28 | The optional parameter --verbose makes much more verbose status and error messages. Use this when troubleshooting any problem or preparing program output to ask for help or report a bug. 29 | 30 | =item * 31 | The optional parameter --resize may be used when writing to an SD card. After writing, it attempts to find the root filesystem on the SD card and resizes it to take the remainder of the free space on the device. This has been tested to work with the popular OS distributions and how they set up their partitions on installation. (However, in case any distributions make changes, please report any errors so they can be fixed.) Currently resizing of Ext2/3/4 and BTRFS filesystems is supported. 32 | 33 | =item * 34 | input-file is the path of the binary image file used as input for flashing the SD card. If it's a .img file then it will be flashed directly. If it's a gzip (.gz), xz (.xz) or zip (.zip) file then the .img file will be extracted from it to flash the SD card. It is not necessary to unpack the file if it's in one of these formats. This covers most of the images downloadable from the Raspberry Pi foundation's web site. 35 | 36 | =item * 37 | output-file is the path to the block device where the SSD card is located. The device should not be mounted - if it ismounted the script will detect it and exit with an error. This operation will erase the SD card and write the new image from the input-file to it. (So make sure it's an SD card you're willing to have erased.) 38 | 39 | =item * 40 | The --sdsearch parameter tells piflash to print a list of device names for SD cards available on the system and then exit. Do not specify an input file or output device when using this option - it will exit before they would be used. 41 | 42 | =item * 43 | The --version parameter tells piflash to print its version number and exit. 44 | 45 | =back 46 | 47 | =head2 Safety Checks 48 | 49 | The program makes a number of safety checks for you. Since the SD card flashing process may need root permissions, these are considered prudent precautions. 50 | 51 | =over 1 52 | 53 | =item * 54 | The input file's format will be checked. If it ends in .img then it will be flashed directly as a binary image file. If it ends in .xz, .gzip or .zip, it will extract the binary image from the file. If the filename doesn't have a suffix, libmagic will be used to inspect the contents of the file (for "magic numbers") to determine its format. 55 | 56 | =item * 57 | The output device must be a block device. 58 | 59 | =item * 60 | If the output device is a mounted filesystem, it will refuse to erase it. 61 | 62 | =item * 63 | If the output device is not an SD card, it will refuse to erase it. 64 | Piflash has been tested with USB and PCI based SD card interfaces. 65 | 66 | =back 67 | 68 | =head2 Automated Flashing Procedure 69 | 70 | Piflash automates the process of flashing an SD card from various Raspberry Pi OS images. 71 | 72 | =over 1 73 | 74 | =item * 75 | For most disk images, either in a raw *.img file, compressed in a *.gz or *.xz file, or included in a *.zip archive, piflash recognizes the file format and extracts the disk image for flashing, eliminating the step of uncompressing or unarchiving it before it can be flashed to the SD. 76 | 77 | =item * 78 | For zip archives, it checks if it contains the Raspberry Pi NOOBS (New Out Of the Box System), in which case it handles it differently. The steps it takes are similar to the instructions that one would have to follow manually. It formats a new VFAT filesystem on the card. (FAT/VFAT is the only format recognized by the Raspberry Pi's simple boot loader.) Then it copies the contents of the zip archive into the card, automating the entire flashing process even for a NOOBS system, which previously didn't even have instructions to be done from Linux systems. 79 | 80 | =item * 81 | When the --resize option is provided, it requests piflash to resize the root filesystem to the maximum available size of the SD card. It's ignored for NOOBS because it will wipe out the initial partitions upong installing anything else. In all other cases, it will expand the last filesystem on the SD card, which is traditionally where the root filesystem is placed. (Exceptions may be added if needed for distributions which don't follow this layout.) Currently resizing of Ext2/3/4 and BTRFS filesystems is supported. 82 | 83 | =back 84 | 85 | =head1 INSTALLATION 86 | 87 | The piflash script only works on Linux systems. It depends on features of the Linux kernel to look up whether the output device is an SD card and other information about it. It has been tested so far on Fedora and Ubuntu to get the kernel parameters right for various USB SD card adapters. 88 | 89 | =head2 System Dependencies 90 | 91 | Some programs and libraries must be installed on the system for piflash to work - most packages have such dependencies. 92 | 93 | On RPM-based Linux systems (Red Hat, Fedora, CentOS) the following command, run as root, will install the dependencies. 94 | 95 | dnf install coreutils util-linux sudo perl file-libs perl-File-LibMagic perl-IO perl-Exception-Class perl-Try-Tiny perl-Module-Pluggable perl-File-Path perl-YAML-LibYAML gzip unzip xz e2fsprogs dosfstools 96 | 97 | On Deb-based Linux systems (Debian, Ubuntu, Raspbian) the following command, run as root, will install the dependencies. 98 | 99 | apt-get install coreutils util-linux klibc-utils sudo perl-base libmagic1 libfile-libmagic-perl libio-all-perl libexception-class-perl libtry-tiny-perl libmodule-pluggable-perl libyaml-libyaml-perl gzip xz-utils e2fsprogs dosfstools 100 | 101 | On source-based or other Linux distributions, make sure the following are installed: 102 | 103 | =over 1 104 | 105 | =item programs: 106 | blockdev, dd, echo, gunzip, lsblk, mkdir, mkfs.vfat, mount, perl, sfdisk, sudo, sync, true, umount, unzip, xz 107 | 108 | =item libraries: 109 | libmagic/file-libs, File::LibMagic (perl), IO (perl), Exception::Class (perl), Module::Pluggable (perl), YAML::LibYAML (perl), File::Path (perl) 110 | 111 | =back 112 | 113 | =head3 Installation with cpanm 114 | 115 | If you have cpanm, you only need one line: 116 | 117 | % cpanm PiFlash 118 | 119 | If it does not have permission to install modules to the current perl, cpanm 120 | will automatically set up and install to a local::lib in your home directory. 121 | See the local::lib documentation (L) for 122 | details on enabling it in your environment. 123 | 124 | =head3 Installing with the CPAN shell 125 | 126 | Alternatively, if your CPAN shell is set up, you should just be able to do: 127 | 128 | % cpan PiFlash 129 | 130 | =head3 Manual installation 131 | 132 | As a last resort, you can manually install it. Download the tarball, untar it, 133 | install configure prerequisites (see below), then build it: 134 | 135 | % perl Makefile.PL 136 | % make && make test 137 | 138 | Then install it: 139 | 140 | % make install 141 | 142 | If your perl is system-managed, you can create a local::lib in your home 143 | directory to install modules to. For details, see the local::lib documentation: 144 | L 145 | 146 | The prerequisites of this distribution will also have to be installed manually. The 147 | prerequisites are listed in one of the files: `MYMETA.yml` or `MYMETA.json` generated 148 | by running the manual build process described above. 149 | 150 | =head3 Configure prerequisites 151 | 152 | This distribution requires other modules to be installed before this 153 | distribution's installer can be run. They can be found under the 154 | "configure_requires" key of META.yml or the 155 | "{prereqs}{configure}{requires}" key of META.json. 156 | 157 | =head3 Documentation 158 | 159 | PiFlash documentation is available as POD. 160 | You can run `perldoc` from a shell to read the documentation: 161 | 162 | % perldoc piflash 163 | 164 | For more information on installing Perl modules via CPAN, please see: 165 | L 166 | 167 | =head3 Online resources 168 | 169 | A list of online resources for PiFlash is at L 170 | including where to download Raspberry Pi bootable image files and articles/presentations about PiFlash. 171 | 172 | =head1 EXIT STATUS 173 | 174 | As standard for Unix command-line programs, piflash returns 0 for success and 1 if an error occurred. 175 | Error messages are reported on the standard output. 176 | 177 | =head1 BUGS AND LIMITATIONS 178 | 179 | Report bugs via GitHub at L 180 | 181 | When reporting a bug, please include the full output using the --verbose option. That will include all of the 182 | program's state information, which will help understand the bigger picture what was happening on your system. 183 | Feel free to remove information you don't want to post in a publicly-visible bug report - though it's helpful 184 | to add "[redacted]" where you removed something so it's clear what happened. 185 | 186 | For any SD card reader hardware which piflash fails to recognize (and therefore refuses to write to), 187 | please describe the hardware as best you can including name, product number, bus (USB, PCI, etc), 188 | any known controller chips. 189 | 190 | Patches and enhancements may be submitted via a pull request at L 191 | 192 | =cut 193 | 194 | # run main routine 195 | exit PiFlash::main; 196 | -------------------------------------------------------------------------------- /dist.ini: -------------------------------------------------------------------------------- 1 | name = PiFlash 2 | author = Ian Kluft 3 | license = Apache_2_0 4 | copyright_holder = Ian Kluft 5 | copyright_year = 2017-2022 6 | main_module = bin/piflash 7 | 8 | [Prereqs] 9 | perl = 5.14.0 10 | [ModuleBuild] 11 | [AssertOS] 12 | os = Linux 13 | 14 | [InstallGuide] 15 | [MetaJSON] 16 | [AutoPrereqs] 17 | [PkgVersion] 18 | [NextRelease] 19 | time_zone = America/Los_Angeles 20 | [PodWeaver] 21 | [GithubMeta] 22 | 23 | [Test::Perl::Critic] 24 | critic_config = perlcritic.rc 25 | [PodSyntaxTests] 26 | [Test::CPAN::Changes] 27 | [Test::UnusedVars] 28 | 29 | [PerlTidy] 30 | perltidyrc = perltidy.rc 31 | 32 | [Git::Check] 33 | [NextVersion::Semantic] 34 | major = MAJOR, API CHANGE 35 | minor = MINOR, ENHANCEMENTS, SECURITY 36 | revision = REVISION, BUG FIXES, DOCS 37 | ; must also load a PreviousVersionProvider 38 | [PreviousVersion::Changelog] 39 | [Git::Commit] 40 | allow_dirty = dist.ini 41 | allow_dirty = Changes 42 | commit_msg = PiFlash v%V%n%n%c 43 | [Git::Tag] 44 | tag_format = v%V 45 | tag_message = PiFlash v%V%n%n%c 46 | [Git::Push] 47 | 48 | [@Filter] 49 | -bundle = @Basic 50 | -version = 5.031 51 | -remove = License 52 | -remove = Readme 53 | -remove = MakeMaker 54 | option = for_basic 55 | 56 | [RPM] 57 | spec_file = PiFlash.spec 58 | sign = 0 59 | ignore_build_deps = 0 60 | push_packages = 0 61 | push_ignore_packages = .src.rpm$ 62 | -------------------------------------------------------------------------------- /doc/raspberrypi_board_vector_red.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ikluft/piflash/a3771d78f19fd94f75a3491d2d472c48e3b25190/doc/raspberrypi_board_vector_red.png -------------------------------------------------------------------------------- /doc/resources.pod: -------------------------------------------------------------------------------- 1 | # PODNAME: resources 2 | # ABSTRACT: Online resources for PiFlash 3 | 4 | =pod 5 | 6 | =head1 Online resources for PiFlash 7 | 8 | This is a list of online resources for PiFlash 9 | 10 | =over 11 | 12 | =item L 13 | 14 | =item L 15 | 16 | =back 17 | 18 | =head2 Where to download Raspberry Pi bootable images 19 | 20 | The first place to look for Raspberry Pi bootable images is usually the Raspberry Pi Foundation's download page. 21 | https://www.raspberrypi.org/downloads/ . But they stopped adding new sources long ago. There are more. These OS downloads include SD card images for the Raspberry Pi. 22 | 23 | Please suggest (or directly submit edits via pull requests on GitHub) other places to download bootable Raspberry Pi images (SD card files). 24 | 25 | This is also the list to watch that PiFlash should be able to recognize the file types available for download here and automatically handle them all. If anything changes in the file formats offered in these downloads, please point it out so PiFlash can be updated to work with it. 26 | 27 | =over 28 | 29 | =item L 30 | 31 | Alpine is a compact security-oriented Linux distribution, popular for containter and IoT 32 | (uses its own packaging system) 33 | 34 | =item L 35 | 36 | Arch is a compact Linux distribution based on a rolling-release model 37 | (uses its own packaging system) 38 | 39 | =item L 40 | 41 | Fedora is the Open Source Linux distribution which acts as the foundation that RedHat Enterprise Linux is built on 42 | (based on RPM RedHat Package Manager) 43 | 44 | =item L 45 | 46 | FreeBSD is the largest Open Source derivative of Berkeley BSD Unix 47 | 48 | =item L 49 | 50 | personal server project of Debian Linux 51 | 52 | =item L 53 | 54 | Slackware Linux, one of the original Linux distributions 55 | (uses its own packaging system) 56 | 57 | =back 58 | 59 | =head2 Presentations and Articles 60 | 61 | =over 62 | 63 | =item L<"Getting started with PiFlash: Booting your Raspberry Pi on Linux"|https://opensource.com/article/19/3/piflash> 64 | article by Ian Kluft at OpenSource.com on March 15, 2019 65 | 66 | =item L<"PiFlash: Linux utility to flash SD cards for Raspberry Pi computers"|https://www.slideshare.net/ikluft/piflash-linux-utility-to-flash-sd-cards-for-raspberry-pi-computers> 67 | presentation by Ian Kluft at Silicon Valley Perl (SVPerl) inSunnyvale, California on February 7, 2019 68 | 69 | =item L<"Getting started with Perl on the Raspberry Pi"|https://opensource.com/article/17/3/perl-raspberry-pi> 70 | article by Ian Kluft at OpenSource.com on March 13, 2017 71 | 72 | =item L<"Perl on Raspberry Pi"|https://www.slideshare.net/ikluft/perl-on-raspberry-pi-svperl-20170202> 73 | presentation by Ian Kluft at Silicon Valley Perl (SVPerl) in Santa Clara, California on February 2, 2017 74 | 75 | =back 76 | -------------------------------------------------------------------------------- /lib/PiFlash.pm: -------------------------------------------------------------------------------- 1 | # PiFlash - flash a Raspberry Pi image to an SD card, with safety checks to avoid erasing wrong device 2 | # This module/script uses sudo to perform root-privileged functions. 3 | # by Ian Kluft 4 | 5 | # pragmas to silence some warnings from Perl::Critic 6 | ## no critic (Modules::RequireExplicitPackage) 7 | # This solves a catch-22 where parts of Perl::Critic want both package and use-strict to be first 8 | use strict; 9 | use warnings; 10 | use utf8; 11 | ## use critic (Modules::RequireExplicitPackage) 12 | 13 | package PiFlash; 14 | 15 | use feature qw(say); 16 | use autodie; # report errors instead of silently continuing ("die" actions are used as exceptions - caught & reported) 17 | use Getopt::Long qw(GetOptionsFromArray); # included with perl 18 | use File::Basename; # included with perl 19 | use File::Path qw(make_path); # RPM: perl-File-Path, DEB: included with perl 20 | use PiFlash::State; 21 | use PiFlash::Plugin; 22 | use PiFlash::Command; 23 | use PiFlash::Inspector; 24 | use PiFlash::MediaWriter; 25 | 26 | # ABSTRACT: Raspberry Pi SD-flashing script with safety checks to avoid erasing the wrong device 27 | 28 | =head1 SYNOPSIS 29 | 30 | exit PiFlash::main; 31 | 32 | =head1 DESCRIPTION 33 | 34 | See the L program for details on installation and running the program at the command line. 35 | 36 | The PiFlash module is the top-level command-line processing level of the L script 37 | to flash an SD card for a Raspberry Pi single-board computer. 38 | The main function serves as an exception catching wrapper which calls the piflash function 39 | to process the command line. 40 | 41 | =head1 SEE ALSO 42 | 43 | L, L, L, L 44 | 45 | L - Online resources for PiFlash 46 | 47 | L - main PiFlash release page on MetaCPAN 48 | 49 | L - PiFlash repository on GitHub 50 | 51 | =head1 BUGS AND LIMITATIONS 52 | 53 | Report bugs via GitHub at L 54 | 55 | Patches and enhancements may be submitted via a pull request at L 56 | 57 | =cut 58 | 59 | # return default list of state category names 60 | # this is made available externally so it can be accessed for testing 61 | sub state_categories 62 | { 63 | return ( 64 | "cli_opt", # options received from command line 65 | "config", # configuration settings loaded from YAML $XDG_CONFIG_DIR/piflash 66 | "hook", # hook functions: callbacks managed by PiFlash::Hook 67 | "input", # input file info from PiFlash::Inspector 68 | "log", # log of commands and events 69 | "output", # output device info from PiFlash::Inspector 70 | "plugin", # plugin modules assigned storage here 71 | "system", # system info from PiFlash::Inspector 72 | ); 73 | } 74 | 75 | # return list of command-line options in Getopt::Long-compatible format 76 | sub cli_def 77 | { 78 | return ( 79 | "config:s", # configuration file 80 | "help", # display help/usage and exit 81 | "logging", # command logging (similar to verbose mode without printing anything) 82 | "plugin:s", # list of user-enabled plugins (also enabled from config file) 83 | "resize", # resize root filesystem after writing to SD card 84 | "sdsearch", # display list of SD card devices and exit 85 | "test:s%", # set test flags (used by unit tests only) 86 | "verbose", # log and print lots of actions for troubleshooting 87 | "version", # print version number and exit 88 | ); 89 | } 90 | 91 | # print program usage message 92 | sub usage 93 | { 94 | my @args = @_; 95 | my @msg; 96 | if (@args) { 97 | push @msg, shift; 98 | foreach my $arg (@args) { 99 | push @msg, " $arg"; 100 | } 101 | } 102 | push @msg, 103 | "usage: " . basename($0) . " [--verbose | --logging] [--resize] [--config conf-file] input-file output-device"; 104 | push @msg, " " . basename($0) . " [--verbose | --logging] [--config conf-file] --SDsearch"; 105 | push @msg, " " . basename($0) . " --version"; 106 | die join( "\n", @msg ) . "\n"; 107 | } 108 | 109 | # print numbers with readable suffixes for megabytes, gigabytes, terabytes, etc 110 | # handle more prefixes than currently needed for extra scalability to keep up with Moore's Law for a while 111 | sub num_readable 112 | { 113 | my $num = shift; 114 | my @suffixes = qw(bytes KB MB GB TB PB EB ZB); 115 | my $magnitude = int( log($num) / log(1024) ); 116 | if ( $magnitude > scalar @suffixes ) { 117 | $magnitude = scalar @suffixes; 118 | } 119 | my $num_base = $num / ( 1024**($magnitude) ); 120 | return sprintf "%4.2f%s", $num_base, $suffixes[$magnitude]; 121 | } 122 | 123 | # command-line argument processing 124 | # this is used by PiFlash mainline and unit tests 125 | sub process_cli 126 | { 127 | my $cmdline = shift // \@ARGV; 128 | 129 | # collect and validate command-line arguments 130 | { 131 | my @warn; 132 | local $SIG{__WARN__} = sub { 133 | if ( length $_[0] > 0 ) { 134 | push @warn, $_[0]; 135 | } 136 | }; 137 | my $getopt_result = eval { GetOptionsFromArray( $cmdline, PiFlash::State::cli_opt(), PiFlash::cli_def() ) }; 138 | if ($@) { 139 | 140 | # in case of failure, add state info if verbose or logging mode is set 141 | usage( "command option error: ", $@ ); 142 | } elsif (@warn) { 143 | chomp @warn; 144 | my $line1 = shift @warn; 145 | usage( "command option error: $line1", @warn ); 146 | } elsif ( !$getopt_result ) { 147 | usage("command option error"); 148 | } 149 | } 150 | 151 | # check for errors such as insufficient parameters or missing files 152 | my @errors; 153 | my $cli_query_mode = 0; 154 | foreach my $opt (qw(help sdsearch version)) { 155 | if ( PiFlash::State::has_cli_opt($opt) ) { 156 | $cli_query_mode = 1; 157 | last; 158 | } 159 | } 160 | my $test_flags = PiFlash::State::cli_opt("test"); 161 | if ( scalar @$cmdline < 2 ) { 162 | if ( not $cli_query_mode ) { 163 | push @errors, "missing argument - need an existing source file and destination device"; 164 | } 165 | } else { 166 | if ( not -e $cmdline->[0] ) { 167 | push @errors, "source file parameter $cmdline->[0] does not exist"; 168 | } elsif ( not -f $cmdline->[0] ) { 169 | push @errors, "source file parameter $cmdline->[0] is not a regular file"; 170 | } 171 | if ( not exists $test_flags->{skip_block_check} ) { 172 | 173 | # test that the block device exists and is really a block device 174 | # note: this may be skipped by "--test skip_block_check=1" for testing CLI options 175 | if ( not -e $cmdline->[1] ) { 176 | push @errors, "destination device parameter $cmdline->[1] does not exist"; 177 | } elsif ( not -b $cmdline->[1] ) { 178 | push @errors, "destination device parameter $cmdline->[1] is not a block device"; 179 | } 180 | } 181 | } 182 | 183 | # TODO insert subcommand processing here 184 | 185 | # if there were errors, print them with program usage info and exit 186 | if (@errors) { 187 | usage(@errors); 188 | } 189 | return; 190 | } 191 | 192 | # PiFlash main routine 193 | sub piflash 194 | { 195 | # initialize program state storage 196 | PiFlash::State->init( state_categories() ); 197 | 198 | # process command line 199 | process_cli(); 200 | 201 | # if --help option was selected, print usage info and exit 202 | if ( PiFlash::State::has_cli_opt("help") ) { 203 | usage(); 204 | } 205 | 206 | # if --version option was selected, print the version number and exit 207 | if ( PiFlash::State::has_cli_opt("version") ) { 208 | say $PiFlash::VERSION; 209 | return; 210 | } 211 | 212 | # read configuration 213 | my $config_file; 214 | if ( PiFlash::State::has_cli_opt("config") ) { 215 | $config_file = PiFlash::State::cli_opt("config"); 216 | } else { 217 | my $config_dir = $ENV{XDG_CONFIG_DIR} // ( $ENV{HOME} . "/.local" ); 218 | make_path($config_dir); 219 | $config_file = $config_dir . "/piflash"; 220 | } 221 | if ( -f $config_file ) { 222 | PiFlash::State::read_config($config_file); 223 | } 224 | 225 | # initialize enabled plugins 226 | # this has to be done after command line and configuration processing so we know what the user has enabled 227 | # since PiFlash runs root code, plugins are disabled by default 228 | PiFlash::Plugin->init_plugins(); 229 | 230 | # collect system info: kernel specs and locations of needed programs 231 | PiFlash::Inspector::collect_system_info(); 232 | 233 | # if --SDsearch option was selected, search for SD cards and exit 234 | if ( PiFlash::State::has_cli_opt("sdsearch") ) { 235 | 236 | # SDsearch mode: print list of SD card devices and exit 237 | PiFlash::Inspector::sd_search(); 238 | return; 239 | } 240 | 241 | # call hook for after reading command-line options 242 | PiFlash::Hook::cli_options(); 243 | 244 | # set input and output paths 245 | PiFlash::State::input( "path", $ARGV[0] ); 246 | PiFlash::State::output( "path", $ARGV[1] ); 247 | say "requested to flash " . PiFlash::State::input("path") . " to " . PiFlash::State::output("path"); 248 | say "output device " . PiFlash::State::output("path") . " will be erased"; 249 | 250 | # check the input file 251 | PiFlash::Inspector::collect_file_info(); 252 | 253 | # check the output device 254 | PiFlash::Inspector::collect_device_info(); 255 | 256 | # check input file and output device sizes 257 | if ( PiFlash::State::input("size") > PiFlash::State::output("size") ) { 258 | PiFlash::State->error( "output device not large enough for this image - currently have: " 259 | . num_readable( PiFlash::State::output("size") ) 260 | . ", minimum size: " 261 | . num_readable( PiFlash::State::input("size") ) ); 262 | } 263 | 264 | # check if SD card is recommended 8GB - check for 6GB since it isn't a hard limit 265 | if ( PiFlash::State::has_input("NOOBS") and PiFlash::State::output("size") < 6 * 1024 * 1024 * 1024 ) { 266 | PiFlash::State->error( 267 | "NOOBS images want 8GB SD card - currently have: " . num_readable( PiFlash::State::output("size") ) ); 268 | } 269 | 270 | # test access to root privilege 271 | # sudo should be configured to not prompt for a password again on this session for some minutes 272 | say "verify sudo access"; 273 | do { PiFlash::Command::cmd( "sudo test", PiFlash::Command::prog("sudo"), PiFlash::Command::prog("true") ); }; 274 | if ($@) { 275 | 276 | # in case of failure, report that root privilege is required 277 | PiFlash::State->error("root privileges required to run this script"); 278 | } 279 | 280 | # flash the device 281 | PiFlash::MediaWriter::flash_device(); 282 | return; 283 | } 284 | 285 | # run main routine and catch exceptions 286 | sub main 287 | { 288 | local $@ = undef; # avoid interference from anything that modifies global $@ 289 | do { piflash(); }; 290 | 291 | # catch any exceptions thrown in main routine 292 | if ( my $exception = $@ ) { 293 | if ( ref $exception ) { 294 | 295 | # exception is an object - try common output functions in case they include more details 296 | # these are not generated by this program - but if another module surprises us, try to handle it gracefully 297 | if ( $exception->can('as_string') ) { 298 | 299 | # typical of Exception::Class derivative classes 300 | PiFlash::State->error( "[" . ( ref $exception ) . "]: " . $exception->as_string() ); 301 | } 302 | if ( $exception->can('to_string') ) { 303 | 304 | # typical of Exception::Base derivative classes 305 | PiFlash::State->error( "[" . ( ref $exception ) . "]: " . $exception->to_string() ); 306 | } 307 | 308 | # if exception object was not handled, fall through and print whatever it says as if it's a string 309 | } 310 | 311 | # print exception as a plain string 312 | # don't run this through PiFlash::State->error() because it probably already came from there 313 | say STDERR "$0 failed: $@"; 314 | return 1; 315 | } else { 316 | if ( PiFlash::State::verbose() or PiFlash::State::logging() ) { 317 | say "Program state dump...\n" . PiFlash::State::odump( PiFlash::State::get_state(), 0 ); 318 | } 319 | } 320 | 321 | # return success 322 | return 0; 323 | } 324 | 325 | 1; 326 | -------------------------------------------------------------------------------- /lib/PiFlash/Command.pm: -------------------------------------------------------------------------------- 1 | # PiFlash::Command - run commands including fork paramaters and piping input & output 2 | # by Ian Kluft 3 | 4 | # pragmas to silence some warnings from Perl::Critic 5 | ## no critic (Modules::RequireExplicitPackage) 6 | # This solves a catch-22 where parts of Perl::Critic want both package and use-strict to be first 7 | use strict; 8 | use warnings; 9 | use utf8; 10 | ## use critic (Modules::RequireExplicitPackage) 11 | 12 | package PiFlash::Command; 13 | 14 | use autodie; 15 | use POSIX; # included with perl 16 | use IO::Handle; # rpm: "dnf install perl-IO", deb: included with perl 17 | use IO::Poll qw(POLLIN POLLHUP); # same as IO::Handle 18 | use Carp qw(carp croak); 19 | use PiFlash::State; 20 | 21 | # ABSTRACT: process/command running utilities for piflash 22 | 23 | =head1 SYNOPSIS 24 | 25 | PiFlash::Command::cmd( label, command_line) 26 | PiFlash::Command::cmd2str( label, comannd_line) 27 | PiFlash::Command::prog( "program-name" ) 28 | 29 | =head1 DESCRIPTION 30 | 31 | This class contains internal functions used by L to run programs and return their status, as well as piping 32 | their input and output. 33 | 34 | =head1 SEE ALSO 35 | 36 | L, L, L 37 | 38 | =head1 BUGS AND LIMITATIONS 39 | 40 | Report bugs via GitHub at L 41 | 42 | Patches and enhancements may be submitted via a pull request at L 43 | 44 | =cut 45 | 46 | # fork wrapper function 47 | # borrowed from Aaron Crane's YAPC::EU 2009 presentation slides online 48 | sub fork_child 49 | { 50 | my ($child_process_code) = @_; 51 | 52 | # fork and catch errors 53 | my $pid = fork; 54 | if ( !defined $pid ) { 55 | PiFlash::State->error("Failed to fork: $!\n"); 56 | } 57 | 58 | # if in parent process, return child pid 59 | if ( $pid != 0 ) { 60 | return $pid; 61 | } 62 | 63 | # if in child process, run requested code 64 | my $result = $child_process_code->(); 65 | 66 | # if we got here, child code returned - so exit to end the subprocess 67 | exit $result; 68 | } 69 | 70 | # command logging function 71 | sub cmd_log 72 | { 73 | my @args = @_; 74 | 75 | # record all command return codes, stdout & stderr in a new top-level store in State 76 | # it's overhead but useful for problem-reporting, troubleshooting, debugging and testing 77 | if ( PiFlash::State::verbose() or PiFlash::State::logging() ) { 78 | my $log = PiFlash::State::log(); 79 | if ( !exists $log->{cmd} ) { 80 | $log->{cmd} = []; 81 | } 82 | push @{ $log->{cmd} }, {@args}; 83 | } 84 | return; 85 | } 86 | 87 | # return new structure of child I/O file descriptors 88 | sub init_child_io 89 | { 90 | my $cmdname = shift; 91 | my $childio = { 92 | cmdname => $cmdname, 93 | in => { read => undef, write => undef }, 94 | out => { read => undef, write => undef }, 95 | err => { read => undef, write => undef } 96 | }; 97 | pipe $childio->{in}{read}, $childio->{in}{write} 98 | or PiFlash::State->error("fork_exec($cmdname): failed to open child process input pipe: $!"); 99 | pipe $childio->{out}{read}, $childio->{out}{write} 100 | or PiFlash::State->error("fork_exec($cmdname): failed to open child process output pipe: $!"); 101 | pipe $childio->{err}{read}, $childio->{err}{write} 102 | or PiFlash::State->error("fork_exec($cmdname): failed to open child process error pipe: $!"); 103 | return $childio; 104 | } 105 | 106 | # start child process 107 | sub child_proc 108 | { 109 | my ( $childio, @args ) = @_; 110 | 111 | # in child process 112 | 113 | # close our copy of parent's end of pipes to avoid deadlock - it must now be only one with them open 114 | my $cmdname = $childio->{cmdname}; 115 | close $childio->{in}{write} 116 | or croak "fork_exec($cmdname): child failed to close parent process input writer pipe: $!"; 117 | close $childio->{out}{read} 118 | or croak "fork_exec($cmdname): child failed to close parent process output reader pipe: $!"; 119 | close $childio->{err}{read} 120 | or croak "fork_exec($cmdname): child failed to close parent process error reader pipe: $!"; 121 | 122 | # dup file descriptors into child's standard in=0/out=1/err=2 positions 123 | POSIX::dup2( fileno $childio->{in}{read}, 0 ) 124 | or croak "fork_exec($cmdname): child failed to reopen stdin from pipe: $!\n"; 125 | POSIX::dup2( fileno $childio->{out}{write}, 1 ) 126 | or croak "fork_exec($cmdname): child failed to reopen stdout to pipe: $!\n"; 127 | POSIX::dup2( fileno $childio->{err}{write}, 2 ) 128 | or croak "fork_exec($cmdname): child failed to reopen stderr to pipe: $!\n"; 129 | 130 | # close the file descriptors that were just consumed by dup2 131 | close $childio->{in}{read} 132 | or croak "fork_exec($cmdname): child failed to close child process input reader pipe: $!"; 133 | close $childio->{out}{write} 134 | or croak "fork_exec($cmdname): child failed to close child process output writer pipe: $!"; 135 | close $childio->{err}{write} 136 | or croak "fork_exec($cmdname): child failed to close child process error writer pipe: $!"; 137 | 138 | # execute the command 139 | exec @args 140 | or croak "fork_exec($cmdname): failed to execute command - returned $?"; 141 | } 142 | 143 | # monitor child process from parent 144 | sub monitor_child 145 | { 146 | my ($childio) = @_; 147 | 148 | # in parent process 149 | 150 | # close our copy of child's end of pipes to avoid deadlock - it must now be only one with them open 151 | my $cmdname = $childio->{cmdname}; 152 | close $childio->{in}{read} 153 | or PiFlash::State->error("fork_exec($cmdname): parent failed to close child process input reader pipe: $!"); 154 | close $childio->{out}{write} 155 | or PiFlash::State->error("fork_exec($cmdname): parent failed to close child process output writer pipe: $!"); 156 | close $childio->{err}{write} 157 | or PiFlash::State->error("fork_exec($cmdname): parent failed to close child process error writer pipe: $!"); 158 | 159 | # write to child's input if any content was provided 160 | if ( exists $childio->{in_data} ) { 161 | 162 | # blocks until input is accepted - this interface reqiuires child commands using input take it before output 163 | # because parent process is not multithreaded 164 | my $writefd = $childio->{in}{write}; 165 | if ( not say $writefd join( "\n", @{ $childio->{in_data} } ) ) { 166 | PiFlash::State->error("fork_exec($cmdname): failed to write child process input: $!"); 167 | } 168 | } 169 | close $childio->{in}{write}; 170 | 171 | # use IO::Poll to collect child output and error separately 172 | my @fd = ( $childio->{out}{read}, $childio->{err}{read} ); # file descriptors for out(0) and err(1) 173 | my @text = ( undef, undef ); # received text for out(0) and err(1) 174 | my @done = ( 0, 0 ); # done flags for out(0) and err(1) 175 | my $poll = IO::Poll->new(); 176 | $poll->mask( $fd[0] => POLLIN ); 177 | $poll->mask( $fd[1] => POLLIN ); 178 | while ( not $done[0] or not $done[1] ) { 179 | 180 | # wait for input 181 | if ( $poll->poll() == -1 ) { 182 | PiFlash::State->error("fork_exec($cmdname): poll failed: $!"); 183 | } 184 | for ( my $i = 0 ; $i <= 1 ; $i++ ) { 185 | if ( !$done[$i] ) { 186 | my $events = $poll->events( $fd[$i] ); 187 | if ( $events && ( POLLIN || POLLHUP ) ) { 188 | 189 | # read all available input for input or hangup events 190 | # we do this for hangup because Linux kernel doesn't report input when a hangup occurs 191 | my $buffer; 192 | while ( read( $fd[$i], $buffer, 1024 ) != 0 ) { 193 | ( defined $text[$i] ) or $text[$i] = ""; 194 | $text[$i] .= $buffer; 195 | } 196 | if ( $events && (POLLHUP) ) { 197 | 198 | # hangup event means this fd (out=0, err=1) was closed by the child 199 | $done[$i] = 1; 200 | $poll->remove( $fd[$i] ); 201 | close $fd[$i]; 202 | } 203 | } 204 | } 205 | } 206 | } 207 | 208 | # reap the child process status 209 | my $pid = $childio->{pid}; 210 | waitpid( $pid, 0 ); 211 | 212 | # return child status 213 | my $result = {}; 214 | $result->{return_code} = $?; 215 | $result->{text} = \@text; 216 | return $result; 217 | } 218 | 219 | # fork/exec wrapper to run child processes and collect output/error results 220 | # used as lower level call by cmd() and cmd2str() 221 | # adds more capability than qx()/backtick/system - wrapper lets us send input & capture output/error data 222 | sub fork_exec 223 | { 224 | my @args = @_; 225 | 226 | # input for child process may be provided as reference to array - use it and remove it from parameters 227 | my $input_ref; 228 | if ( ref $args[0] eq "ARRAY" ) { 229 | $input_ref = shift @args; 230 | } 231 | if ( PiFlash::State::verbose() ) { 232 | say STDERR "fork_exec running: " . join( " ", @args ); 233 | } 234 | my $cmdname = shift @args; 235 | 236 | # open pipes for child process stdin, stdout, stderr 237 | my $childio = init_child_io($cmdname); 238 | if ( defined $input_ref ) { 239 | $childio->{in_data} = $input_ref; 240 | } 241 | 242 | # fork the child process 243 | $childio->{pid} = fork_child( sub { child_proc( $childio, @args ) } ); 244 | 245 | # in parent process 246 | my $result = monitor_child($childio); 247 | 248 | # record all command return codes, stdout & stderr in a new top-level store in State 249 | # it's overhead but useful for problem-reporting, troubleshooting, debugging and testing 250 | cmd_log( 251 | cmdname => $cmdname, 252 | cmdline => [@args], 253 | returncode => $result->{return_code} >> 8, 254 | ( 255 | ( $result->{return_code} & 127 ) 256 | ? ( 257 | signal => sprintf "signal %d%s", 258 | ( $result->{return_code} & 127 ), 259 | ( ( $result->{return_code} & 128 ) ? " with coredump" : "" ) 260 | ) 261 | : () 262 | ), 263 | out => $result->{text}[0], 264 | err => $result->{text}[1] 265 | ); 266 | 267 | # catch errors 268 | if ( $result->{return_code} == -1 ) { 269 | PiFlash::State->error("failed to execute $cmdname command: $!"); 270 | } elsif ( $result->{return_code} & 127 ) { 271 | PiFlash::State->error( 272 | sprintf "%s command died with signal %d, %s coredump", 273 | $cmdname, 274 | ( $result->{return_code} & 127 ), 275 | ( $result->{return_code} & 128 ) ? 'with' : 'without' 276 | ); 277 | } elsif ( $result->{return_code} != 0 ) { 278 | PiFlash::State->error( sprintf "%s command exited with value %d", $cmdname, $result->{return_code} >> 8 ); 279 | } 280 | 281 | # return output/error 282 | return @{ $result->{text} }; 283 | } 284 | 285 | # run a command 286 | # usage: cmd( label, command_line) 287 | # label: a descriptive name of the action this is performing 288 | # command_line: shell command line (pipes and other shell metacharacters allowed) 289 | # note: if there are no shell special characters then all command-line parameters need to be passed separately. 290 | # If there are shell special characters then it will be given to the shell for parsing. 291 | sub cmd 292 | { 293 | my ( $cmdname, @args ) = @_; 294 | if ( PiFlash::State::verbose() ) { 295 | say STDERR "cmd running: " . join( " ", @args ); 296 | } 297 | system(@args); 298 | cmd_log( 299 | cmdname => $cmdname, 300 | cmdline => [@args], 301 | returncode => $? >> 8, 302 | ( 303 | ( $? & 127 ) 304 | ? ( signal => sprintf "signal %d%s", ( $? & 127 ), ( ( $? & 128 ) ? " with coredump" : "" ) ) 305 | : () 306 | ), 307 | ); 308 | if ( $? == -1 ) { 309 | PiFlash::State->error("failed to execute $cmdname command: $!"); 310 | } elsif ( $? & 127 ) { 311 | PiFlash::State->error( 312 | sprintf "%s command died with signal %d, %s coredump", 313 | $cmdname, 314 | ( $? & 127 ), 315 | ( $? & 128 ) ? 'with' : 'without' 316 | ); 317 | } elsif ( $? != 0 ) { 318 | PiFlash::State->error( sprintf "%s command exited with value %d", $cmdname, $? >> 8 ); 319 | } 320 | return 1; 321 | } 322 | 323 | # run a command and return the output as a string 324 | # This originally used qx() to fork child process and obtain output. But Perl::Critic discourages use of qx/backtick. 325 | # And it would be useful to provide input to child process, rather than using a wasteful echo-to-pipe shell command. 326 | # So the fork_exec_wrapper() was added as a lower-level base for cmd() and cmd2str(). 327 | sub cmd2str 328 | { 329 | my ( $cmdname, @args ) = @_; 330 | my ( $out, $err ) = fork_exec( $cmdname, @args ); 331 | if ( defined $err ) { 332 | carp( "$cmdname had error output:\n" . $err ); 333 | } 334 | if (wantarray) { 335 | return split /\n/x, $out; 336 | } 337 | return $out; 338 | } 339 | 340 | # generate name of environment variable for where to find a command 341 | # this is broken out as a separate function for tests to use it 342 | sub envprog 343 | { 344 | my $progname = shift; 345 | my $envprog = ( uc $progname ) . "_PROG"; 346 | $envprog =~ s/[\W-]+/_/xg; # collapse any sequences of non-alphanumeric/non-underscore to a single underscore 347 | return $envprog; 348 | } 349 | 350 | # look up secure program path 351 | sub prog 352 | { 353 | my $progname = shift; 354 | 355 | if ( !PiFlash::State::has_system("prog") ) { 356 | PiFlash::State::system( "prog", {} ); 357 | } 358 | my $prog = PiFlash::State::system("prog"); 359 | 360 | # call with undef to initialize cache (mainly needed for testing because normal use will auto-create it) 361 | if ( !defined $progname ) { 362 | return; 363 | } 364 | 365 | # return value from cache if found 366 | if ( exists $prog->{$progname} ) { 367 | return $prog->{$progname}; 368 | } 369 | 370 | # if we didn't have the location of the program, look for it and cache the result 371 | my $envprog = envprog($progname); 372 | if ( exists $ENV{$envprog} and -x $ENV{$envprog} ) { 373 | $prog->{$progname} = $ENV{$envprog}; 374 | return $prog->{$progname}; 375 | } 376 | 377 | # search paths in order emphasizing recent Linux Filesystem that prefers /usr/bin, then Unix PATH order 378 | for my $path ( "/usr/bin", "/sbin", "/usr/sbin", "/bin" ) { 379 | if ( -x "$path/$progname" ) { 380 | $prog->{$progname} = "$path/$progname"; 381 | return $prog->{$progname}; 382 | } 383 | } 384 | 385 | # if we get here, we didn't find a known secure location for the program 386 | PiFlash::State->error( "unknown secure location for $progname - install it or set " . "$envprog to point to it" ); 387 | } 388 | 389 | 1; 390 | -------------------------------------------------------------------------------- /lib/PiFlash/Hook.pm: -------------------------------------------------------------------------------- 1 | # PiFlash::Hook - named dispatch/hook library for PiFlash 2 | # by Ian Kluft 3 | 4 | # pragmas to silence some warnings from Perl::Critic 5 | ## no critic (Modules::RequireExplicitPackage) 6 | # This solves a catch-22 where parts of Perl::Critic want both package and use-strict to be first 7 | use strict; 8 | use warnings; 9 | use utf8; 10 | ## use critic (Modules::RequireExplicitPackage) 11 | 12 | package PiFlash::Hook; 13 | 14 | use feature qw(say); 15 | use autodie; # report errors instead of silently continuing ("die" actions are used as exceptions - caught & reported) 16 | use parent 'PiFlash::Object'; 17 | use Carp qw(confess); 18 | use PiFlash::State; 19 | 20 | # ABSTRACT: named dispatch/hook library for PiFlash 21 | 22 | =head1 SYNOPSIS 23 | 24 | PiFlash::Hook::add( "hook1", sub { ... code ... }); 25 | PiFlash::Hook::hook1(); 26 | PiFlash::Hook::add( "hook2", \&function_name); 27 | PiFlash::Hook::hook2(); 28 | 29 | =head1 DESCRIPTION 30 | 31 | =head1 SEE ALSO 32 | 33 | L, L, L, L, L 34 | 35 | =head1 BUGS AND LIMITATIONS 36 | 37 | Report bugs via GitHub at L 38 | 39 | Patches and enhancements may be submitted via a pull request at L 40 | 41 | =cut 42 | 43 | # initialize hooks hash as empty 44 | ## no critic (ProhibitPackageVars) 45 | our %hooks; 46 | ## use critic 47 | 48 | # required parameter list 49 | # used by PiFlash::Object for new() method 50 | sub object_params 51 | { 52 | return qw(name code origin); 53 | } 54 | 55 | # use AUTOLOAD to call a named hook as if it were a class method 56 | ## no critic (ClassHierarchies::ProhibitAutoloading) 57 | # TODO: pre-generate hook functions to remove AUTOLOAD and its perlcritic exception 58 | our $AUTOLOAD; 59 | 60 | sub AUTOLOAD 61 | { 62 | my ( $self, @args ) = @_; 63 | 64 | # Remove qualifier from original method name... 65 | my $called = $AUTOLOAD =~ s/.*:://rx; 66 | 67 | # differentiate between class and instance methods 68 | if ( defined $self and ref $self eq "PiFlash::Hook" ) { 69 | 70 | # handle instance accessor 71 | # if likely to be used a lot, optimize this by creating accessor function upon first access 72 | if ( exists $self->{$called} ) { 73 | return $self->{$called}; 74 | } 75 | } else { 76 | 77 | # autoloaded class methods run hooks by name 78 | run( $called, @args ); 79 | } 80 | return; 81 | } 82 | ## critic (ClassHierarchies::ProhibitAutoloading) 83 | 84 | # add a code reference to a named hook 85 | sub add 86 | { 87 | my $name = shift; 88 | my $coderef = shift; 89 | if ( ref $coderef ne "CODE" ) { 90 | confess "PiFlash::Hook::add_hook(): can't add $name hook with non-code reference"; 91 | } 92 | if ( !exists $hooks{$name} ) { 93 | $hooks{$name} = []; 94 | } 95 | push @{ $hooks{$name} }, PiFlash::Hook::new( { name => $name, code => $coderef, origin => [caller] } ); 96 | return; 97 | } 98 | 99 | # check if there are any hooks registered for a name 100 | sub has 101 | { 102 | my $name = shift; 103 | return exists $hooks{$name}; 104 | } 105 | 106 | # run the hook code 107 | sub run 108 | { 109 | my ( $name, @args ) = @_; 110 | 111 | # Is there a hook of that name? 112 | if ( !exists $hooks{$name} ) { 113 | if ( PiFlash::State::verbose() ) { 114 | say "PiFlash::Hook dispatch: no such hook $name - ignored"; 115 | } 116 | return; 117 | } 118 | 119 | # call all functions registered in the list for this hook 120 | my @result; 121 | if ( ref $hooks{$name} eq "ARRAY" ) { 122 | foreach my $hook ( @{ $hooks{$name} } ) { 123 | push @result, $hook->{code}(@args); 124 | } 125 | } 126 | return @result; 127 | } 128 | 129 | 1; 130 | -------------------------------------------------------------------------------- /lib/PiFlash/Inspector.pm: -------------------------------------------------------------------------------- 1 | # PiFlash::Inspector - inspection of the Linux system configuration including identifying SD card devices 2 | # by Ian Kluft 3 | 4 | # pragmas to silence some warnings from Perl::Critic 5 | ## no critic (Modules::RequireExplicitPackage) 6 | # This solves a catch-22 where parts of Perl::Critic want both package and use-strict to be first 7 | use strict; 8 | use warnings; 9 | use utf8; 10 | ## use critic (Modules::RequireExplicitPackage) 11 | 12 | package PiFlash::Inspector; 13 | 14 | use feature qw(say); 15 | use autodie; # report errors instead of silently continuing ("die" actions are used as exceptions - caught & reported) 16 | use Try::Tiny; 17 | use Readonly; 18 | use File::Basename; 19 | use File::Slurp qw(slurp); 20 | use File::LibMagic; # rpm: "dnf install perl-File-LibMagic", deb: "apt-get install libfile-libmagic-perl" 21 | use PiFlash::State; 22 | use PiFlash::Command; 23 | 24 | # ABSTRACT: PiFlash functions to inspect Linux system devices to flash an SD card for Raspberry Pi 25 | 26 | =head1 SYNOPSIS 27 | 28 | PiFlash::Inspector::collect_system_info(); 29 | PiFlash::Inspector::collect_file_info(); 30 | PiFlash::Inspector::collect_device_info(); 31 | PiFlash::Inspector::blkparam(\%output, param-name, ...); 32 | $bool = PiFlash::Inspector::is_sd(); 33 | $bool = PiFlash::Inspector::is_sd(\%device_info); 34 | PiFlash::Inspector::sd_search(); 35 | 36 | =head1 DESCRIPTION 37 | 38 | This class contains internal functions used by L in the process of collecting data on the system's devices to determine which are SD cards, to avoid accidentally erasing any devices which are not SD cards. This is for automation of the process of flashing an SD card for a Raspberry Pi single-board computer from a Linux system. 39 | 40 | =head1 SEE ALSO 41 | 42 | L, L, L 43 | 44 | =head1 BUGS AND LIMITATIONS 45 | 46 | Report bugs via GitHub at L 47 | 48 | Patches and enhancements may be submitted via a pull request at L 49 | 50 | =cut 51 | 52 | # 53 | # constants 54 | # 55 | 56 | # recognized file suffixes which SD cards can be flashed from 57 | Readonly::Array my @known_suffixes => qw(gz zip xz img); 58 | 59 | # prefix for functions to process specific file types for embedded boot images 60 | Readonly::Scalar my $process_func_prefix => "process_file_"; 61 | 62 | # These regex patterns are meant to contain spaces to match libmagic output 63 | ## no critic (RegularExpressions::RequireExtendedFormatting) 64 | 65 | # list of libmagic file strings corellated to file type strings as pairs 66 | Readonly::Array my @magic_to_type => ( 67 | [ qr(^Zip archive data)i, "zip" ], 68 | [ qr(^gzip compressed data)i, "gz" ], 69 | [ qr(^XZ compressed data)i, "xz" ], 70 | [ qr(^DOS\/MBR boot sector)i, "img" ], 71 | ); 72 | 73 | # list of libmagic file strings corellated to filesystems as pairs 74 | # a code of 1 means use $1 from regex match, and convert it to lower case 75 | Readonly::Array my @magic_to_fs => ( 76 | [ qr(^Linux rev \d+.\d+ (ext[234]) filesystem data,)i, 1 ], 77 | [ qr(^(\w+) Filesystem)i, 1 ], 78 | [ qr(\s+(\w+)\sfilesystem)i, 1 ], 79 | [ qr(^DOS\/MBR boot sector, .*, FAT (32 bit),)i, "vfat" ], 80 | [ qr(^Linux\/\w+ swap file)i, "swap" ], 81 | ); 82 | ## critic (RegularExpressions::RequireExtendedFormatting) 83 | 84 | # block device parameters to collect via lsblk 85 | Readonly::Array my @blkdev_params => qw(MOUNTPOINT FSTYPE SIZE SUBSYSTEMS TYPE MODEL RO RM HOTPLUG PHY-SEC); 86 | 87 | # 88 | # system data collection functions 89 | # 90 | 91 | # collect data about the system: kernel specs, program locations 92 | sub collect_system_info 93 | { 94 | my $system = PiFlash::State::system(); 95 | 96 | # Make sure we're on a Linux system - this program uses Linux-only features 97 | ( $system->{sysname}, $system->{nodename}, $system->{release}, $system->{version}, $system->{machine} ) = 98 | POSIX::uname(); 99 | if ( $system->{sysname} ne "Linux" ) { 100 | PiFlash::State->error("This depends on features of Linux. Found $system->{sysname} kernel - cannot continue."); 101 | } 102 | 103 | # hard-code known-secure locations of programs here if you need to override any on your system 104 | # $prog{name} = "/path/to/name"; 105 | 106 | # loop through needed programs and record locations from environment variable or system directories 107 | $system->{prog} = {}; 108 | 109 | # set PATH in environment as a precaution - we don't intend to use it but mkfs does 110 | # search paths in standard Unix PATH order 111 | my @path; 112 | for my $path ( "/sbin", "/usr/sbin", "/bin", "/usr/bin" ) { 113 | 114 | # include in PATH standard Unix directories which exist on this system 115 | if ( -d $path ) { 116 | push @path, $path; 117 | } 118 | } 119 | ## no critic (RequireLocalizedPunctuationVars]) 120 | $ENV{PATH} = join ":", @path; 121 | ## use critic 122 | $system->{PATH} = $ENV{PATH}; 123 | 124 | # find filesystems supported by this kernel (for formatting SD card) 125 | my %fs_pref = ( vfat => 1, ext4 => 2, ext3 => 3, ext2 => 4, exfat => 5, other => 6 ); # fs preference order 126 | my @filesystems = grep { not /^nodev\s/x } slurp("/proc/filesystems"); 127 | chomp @filesystems; 128 | for ( my $i = 0 ; $i <= $#filesystems ; $i++ ) { 129 | 130 | # remove leading and trailing whitespace; 131 | $filesystems[$i] =~ s/^\s*//x; 132 | $filesystems[$i] =~ s/\s*$//x; 133 | } 134 | 135 | # sort list by decreasing preference (increasing numbers) 136 | $system->{filesystems} = 137 | [ sort { ( $fs_pref{$a} // $fs_pref{other} ) <=> ( $fs_pref{$b} // $fs_pref{other} ) } @filesystems ]; 138 | $system->{primary_fs} = $system->{filesystems}[0]; 139 | 140 | # find locations where we can put mount points 141 | foreach my $dir (qw(/run/media /media /mnt)) { 142 | if ( -d $dir ) { 143 | PiFlash::State::system( "media_dir", $dir ); # use the first one 144 | last; 145 | } 146 | } 147 | return; 148 | } 149 | 150 | # collect input file info - extra steps for zip file 151 | sub process_file_zip 152 | { 153 | my $input = PiFlash::State::input(); 154 | 155 | # process zip archives 156 | my @zip_content = 157 | PiFlash::Command::cmd2str( "unzip - list contents", PiFlash::Command::prog("unzip"), "-l", $input->{path} ); 158 | chomp @zip_content; 159 | my $found_build_data = 0; 160 | my @imgfiles; 161 | my $zip_lastline = pop @zip_content; # last line contains total size 162 | { 163 | my $size = $zip_lastline; # get last line of unzip output with total size 164 | $size =~ s/^ \s*//x; # remove leading whitespace 165 | $size =~ s/[^\d]*$//x; # remove anything else after numeric digits 166 | $input->{size} = $size; 167 | } 168 | foreach my $zc_entry (@zip_content) { 169 | if ( $zc_entry =~ /\sBUILD-DATA$/x ) { 170 | $found_build_data = 1; 171 | } elsif ( $zc_entry =~ /^\s*(\d+)\s.*\s([^\s]*)$/x ) { 172 | push @imgfiles, [ $2, $1 ]; 173 | } 174 | } 175 | 176 | # detect if the zip archive contains Raspberry Pi NOOBS (New Out Of the Box System) 177 | if ($found_build_data) { 178 | my @noobs_version = grep { /^NOOBS Version:/x } PiFlash::Command::cmd2str( 179 | "unzip - check for NOOBS", 180 | PiFlash::Command::prog("unzip"), 181 | "-p", $input->{path}, "BUILD-DATA" 182 | ); 183 | chomp @noobs_version; 184 | if ( scalar @noobs_version > 0 ) { 185 | if ( $noobs_version[0] =~ /^NOOBS Version: (.*)/x ) { 186 | $input->{NOOBS} = $1; 187 | } 188 | } 189 | } 190 | 191 | # if NOOBS system was not found, look for a *.img file 192 | if ( not exists $input->{NOOBS} ) { 193 | if ( scalar @imgfiles == 0 ) { 194 | PiFlash::State->error("input file is a zip archive but does not contain a *.img file or NOOBS system"); 195 | } 196 | $input->{imgfile} = $imgfiles[0][0]; 197 | $input->{size} = $imgfiles[0][1]; 198 | } 199 | return; 200 | } 201 | 202 | # collect input file info - extra steps for gz file 203 | sub process_file_gz 204 | { 205 | my $input = PiFlash::State::input(); 206 | 207 | # process gzip compressed files 208 | my @gunzip_out = PiFlash::Command::cmd2str( 209 | "gunzip - list contents", 210 | PiFlash::Command::prog("gunzip"), 211 | "--list", "--quiet", $input->{path} 212 | ); 213 | chomp @gunzip_out; 214 | my @fields = split ' ', @gunzip_out; 215 | $input->{size} = $fields[1]; 216 | $input->{imgfile} = $fields[3]; 217 | return; 218 | } 219 | 220 | # collect input file info - extra steps for xz file 221 | sub process_file_xz 222 | { 223 | my $input = PiFlash::State::input(); 224 | 225 | # process xz compressed files 226 | if ( $input->{path} =~ /^.*\/([^\/]*\.img)\.xz/x ) { 227 | $input->{imgfile} = $1; 228 | } 229 | my @xz_out = PiFlash::Command::cmd2str( 230 | "xz - list contents", 231 | PiFlash::Command::prog("xz"), 232 | "--robot", "--list", $input->{path} 233 | ); 234 | chomp @xz_out; 235 | foreach my $xz_line (@xz_out) { 236 | if ( $xz_line =~ /^file\s+\d+\s+\d+\s+\d+\s+(\d+)/x ) { 237 | $input->{size} = $1; 238 | last; 239 | } 240 | } 241 | return; 242 | } 243 | 244 | # collect input file info 245 | # verify existence, deduce file type from contents, get size, check for raw filesystem image or NOOBS archive 246 | sub collect_file_info 247 | { 248 | my $input = PiFlash::State::input(); 249 | 250 | # verify input file exists 251 | if ( not -e $input->{path} ) { 252 | PiFlash::State->error( "input " . $input->{path} . " does not exist" ); 253 | } 254 | if ( not -f $input->{path} ) { 255 | PiFlash::State->error( "input " . $input->{path} . " is not a regular file" ); 256 | } 257 | 258 | # use libmagic/file to collect file data 259 | # it is collected even if type will be determined by suffix so we can later inspect data further 260 | { 261 | my $magic = File::LibMagic->new(); 262 | $input->{info} = $magic->info_from_filename( $input->{path} ); 263 | if ( $input->{info}{mime_type} eq "application/gzip" 264 | or $input->{info}{mime_type} eq "application/x-xz" ) 265 | { 266 | my $uncompress_magic = File::LibMagic->new( uncompress => 1 ); 267 | $input->{info}{uncompress} = $uncompress_magic->info_from_filename( $input->{path} ); 268 | } 269 | } 270 | 271 | # parse the file name 272 | $input->{parse} = {}; 273 | ( $input->{parse}{name}, $input->{parse}{path}, $input->{parse}{suffix} ) = 274 | fileparse( $input->{path}, map { "." . $_ } @known_suffixes ); 275 | 276 | # use libmagic/file to determine file type from contents 277 | PiFlash::State::verbose() and say STDERR "input file is a " . $input->{info}{description}; 278 | foreach my $m2t_pair (@magic_to_type) { 279 | my ( $regex, $type_str) = @$m2t_pair; 280 | PiFlash::State::verbose() and say STDERR "collect_file_info: check $regex"; 281 | 282 | # @magic_to_type constant contains pairs of regex (to match libmagic) and file type string if matched 283 | if ( $input->{info}{description} =~ $regex ) { 284 | $input->{type} = $type_str;; 285 | PiFlash::State::verbose() and say STDERR "collect_file_info: input type = ".$input->{type}; 286 | last; 287 | } 288 | } 289 | if ( not exists $input->{type} ) { 290 | PiFlash::State->error("collect_file_info(): file type not recognized on $input->{path}"); 291 | } 292 | 293 | # get file size - start with raw file size, update later if it's compressed/archive 294 | $input->{size} = -s $input->{path}; 295 | 296 | # find embedded boot image in archived/compressed files of various formats 297 | # call the function named by "process_file_" and file type, if it exists 298 | if ( my $process_func = __PACKAGE__->can( $process_func_prefix . $input->{type} ) ) { 299 | 300 | # call function to process the file type 301 | $process_func->(); 302 | } 303 | return; 304 | } 305 | 306 | # collect output device info 307 | sub collect_device_info 308 | { 309 | my $output = PiFlash::State::output(); 310 | 311 | # check that device exists 312 | if ( not -e $output->{path} ) { 313 | PiFlash::State->error( "output device " . $output->{path} . " does not exist" ); 314 | } 315 | if ( not -b $output->{path} ) { 316 | PiFlash::State->error( "output device " . $output->{path} . " is not a block device" ); 317 | } 318 | 319 | # check block device parameters 320 | 321 | # load block device info into %output 322 | blkparam(@blkdev_params); 323 | if ( $output->{mountpoint} ne "" ) { 324 | PiFlash::State->error("output device is mounted - this operation would erase it"); 325 | } 326 | if ( ( not exists $output->{fstype} ) or $output->{fstype} =~ /^\s*$/x ) { 327 | 328 | # multi-pronged approach to find fstype on output device 329 | # lsblk in util-linux reads filesystem type but errors out for blank drive, which we must allow 330 | # blkid can detect a disk or partition - we allow disks but not partitions for output device 331 | # libmagic can describe the device if all else fails 332 | $output->{fstype} = get_fstype( $output->{path} ) // ""; 333 | } 334 | if ( $output->{fstype} eq "swap" ) { 335 | PiFlash::State->error("output device is a swap device - this operation would erase it"); 336 | } 337 | if ( $output->{type} eq "part" ) { 338 | PiFlash::State->error("output device is a partition - Raspberry Pi flash needs whole SD device"); 339 | } 340 | 341 | # check for SD/MMC card via USB or PCI bus interfaces 342 | if ( not is_sd() ) { 343 | PiFlash::State->error("output device is not an SD card - this operation would erase it"); 344 | } 345 | } 346 | 347 | # blkparam function: get device information with lsblk command 348 | # usage: blkparam(\%output, param-name, ...) 349 | # output: reference to hash with output device parameter strings 350 | # param-name: list of parameter names to read into output hash 351 | sub blkparam 352 | { 353 | my @args = @_; 354 | 355 | # use PiFlash::State::output device unless another hash is provided 356 | my $blkdev; 357 | if ( ref( $args[0] ) eq "HASH" ) { 358 | $blkdev = shift @args; 359 | } else { 360 | $blkdev = PiFlash::State::output(); 361 | } 362 | 363 | # get the device's path 364 | # throw an exception if the device's hash data doesn't have it 365 | if ( not exists $blkdev->{path} ) { 366 | PiFlash::State::error("blkparam: device hash does not contain path to device"); 367 | } 368 | my $path = $blkdev->{path}; 369 | 370 | # loop through the requested parameters and get each one for the device with lsblk 371 | foreach my $paramname (@args) { 372 | if ( exists $blkdev->{ lc $paramname } ) { 373 | 374 | # skip names of existing data to avoid overwriting 375 | say STDERR "blkparam(): skipped collection of parameter $paramname to avoid overwriting existing data"; 376 | next; 377 | } 378 | my $value = PiFlash::Command::cmd2str( 379 | "lsblk lookup of $paramname", 380 | PiFlash::Command::prog("lsblk"), 381 | "--bytes", "--nodeps", "--noheadings", "--output", $paramname, $path 382 | ); 383 | if ( $? == -1 ) { 384 | PiFlash::State->error("blkparam($paramname): failed to execute lsblk: $!"); 385 | } elsif ( $? & 127 ) { 386 | PiFlash::State->error( 387 | sprintf "blkparam($paramname): lsblk died with signal %d, %s coredump", 388 | ( $? & 127 ), 389 | ( $? & 128 ) ? 'with' : 'without' 390 | ); 391 | } elsif ( $? != 0 ) { 392 | PiFlash::State->error( sprintf "blkparam($paramname): lsblk exited with value %d", $? >> 8 ); 393 | } 394 | chomp $value; 395 | $value =~ s/^\s*//x; # remove leading whitespace 396 | $value =~ s/\s*$//x; # remove trailing whitespace 397 | $blkdev->{ lc $paramname } = $value; 398 | } 399 | return; 400 | } 401 | 402 | # check if a device is an SD card 403 | sub is_sd 404 | { 405 | my @args = @_; 406 | 407 | # use PiFlash::State::output device unless another hash is provided 408 | my $blkdev; 409 | if ( ref( $args[0] ) eq "HASH" ) { 410 | $blkdev = shift @args; 411 | } else { 412 | $blkdev = PiFlash::State::output(); 413 | } 414 | 415 | # check for SD/MMC card via USB or PCI bus interfaces 416 | if ( $blkdev->{model} eq "SD/MMC" ) { 417 | 418 | # detected SD card via USB adapter 419 | PiFlash::State::verbose() and say STDERR "output device " . $blkdev->{path} . " is an SD card via USB adapter"; 420 | return 1; 421 | } 422 | 423 | # check if the SD card driver operates this device 424 | my $found_mmc = 0; 425 | my $found_usb = 0; 426 | my @subsystems = split /:/x, $blkdev->{subsystems}; 427 | foreach my $subsystem (@subsystems) { 428 | if ( $subsystem eq "mmc_host" or $subsystem eq "mmc" ) { 429 | $found_mmc = 1; 430 | } 431 | if ( $subsystem eq "usb" ) { 432 | $found_usb = 1; 433 | } 434 | } 435 | if ($found_mmc) { 436 | 437 | # verify that the MMC device is actually an SD card 438 | my $sysfs_devtype_path = "/sys/block/" . basename( $blkdev->{path} ) . "/device/type"; 439 | if ( not -f $sysfs_devtype_path ) { 440 | PiFlash::State->error( "cannot find output device " 441 | . $blkdev->{path} 442 | . " type - Linux kernel " 443 | . PiFlash::State::system("release") 444 | . " may be too old" ); 445 | } 446 | my $sysfs_devtype = slurp($sysfs_devtype_path); 447 | chomp $sysfs_devtype; 448 | PiFlash::State::verbose() and say STDERR "output device " . $blkdev->{path} . " is a $sysfs_devtype"; 449 | if ( $sysfs_devtype eq "SD" ) { 450 | return 1; 451 | } 452 | } 453 | 454 | # allow USB writable/hotplug/removable drives with physical sector size 512 455 | # this is imprecise because some other non-SD flash devices will be accepted as SD 456 | # it will still avoid allowing hard drives to be erased 457 | if ($found_usb) { 458 | if ( $blkdev->{ro} == 0 and $blkdev->{rm} == 1 and $blkdev->{hotplug} == 1 and $blkdev->{"phy-sec"} == 512 ) { 459 | PiFlash::State::verbose() 460 | and say STDERR "output device " . $blkdev->{path} 461 | . " close enough: USB removable writable hotplug ps=512"; 462 | return 1; 463 | } 464 | } 465 | 466 | PiFlash::State::verbose() and say STDERR "output device " . $blkdev->{path} . " rejected as SD card"; 467 | return 0; 468 | } 469 | 470 | # search for and print names of SD card devices 471 | sub sd_search 472 | { 473 | # add block devices to system info 474 | my $system = PiFlash::State::system(); 475 | $system->{blkdev} = {}; 476 | 477 | # loop through available devices - collect info and print list of available SD cards 478 | my @blkdev = PiFlash::Command::cmd2str( 479 | "lsblk - find block devices", 480 | PiFlash::Command::prog("lsblk"), 481 | "--nodeps", "--noheadings", "--list", "--output", "NAME" 482 | ); 483 | my @sdcard; 484 | foreach my $blkdevname (@blkdev) { 485 | $system->{blkdev}{$blkdevname} = {}; 486 | my $blkdev = $system->{blkdev}{$blkdevname}; 487 | $blkdev->{path} = "/dev/$blkdevname"; 488 | blkparam( $blkdev, @blkdev_params ); 489 | if ( is_sd($blkdev) ) { 490 | push @sdcard, $blkdev->{path}; 491 | } 492 | } 493 | 494 | # print results of SD search 495 | if ( scalar @sdcard == 0 ) { 496 | say "no SD cards found on system"; 497 | } else { 498 | say "SD cards found: " . join( " ", @sdcard ); 499 | } 500 | return; 501 | } 502 | 503 | # base function: get basename from a file path 504 | sub base 505 | { 506 | my $path = shift; 507 | my $filename = File::Basename::fileparse( $path, () ); 508 | return $filename; 509 | } 510 | 511 | # get filesystem type info 512 | # workaround for apparent bug in lsblk (from util-linux) which omits requested FSTYPE data when in the background 513 | # use blkid or libmagic if it fails 514 | sub get_fstype 515 | { 516 | my $devpath = shift; 517 | my $fstype; 518 | try { 519 | $fstype = PiFlash::Command::cmd2str( 520 | "use lsblk to get fs type for $devpath", 521 | PiFlash::Command::prog("sudo"), 522 | PiFlash::Command::prog("lsblk"), 523 | "--nodeps", "--noheadings", "--output", "FSTYPE", $devpath 524 | ); 525 | } catch { 526 | undef $fstype; 527 | }; 528 | 529 | # fallback: use blkid 530 | if ( ( not defined $fstype ) or $fstype =~ /^\s*$/x ) { 531 | try { 532 | $fstype = PiFlash::Command::cmd2str( 533 | "use blkid to get fs type for $devpath", 534 | PiFlash::Command::prog("sudo"), 535 | PiFlash::Command::prog("blkid"), 536 | "--probe", "--output=value", "--match-tag=TYPE", $devpath 537 | ); 538 | } catch { 539 | undef $fstype; 540 | }; 541 | } 542 | 543 | # fallback 2: use File::LibMagic as backup filesystem type lookup 544 | if ( ( not defined $fstype ) or $fstype =~ /^\s*$/x ) { 545 | my $magic = File::LibMagic->new(); 546 | $fstype = undef; 547 | $magic->{flags} |= File::LibMagic::MAGIC_DEVICES; # undocumented trick for equivalent of "file -s" on device 548 | my $magic_data = $magic->info_from_filename($devpath); 549 | if ( PiFlash::State::verbose() ) { 550 | for my $key ( keys %$magic_data ) { 551 | say STDERR "get_fstype: magic_data/$key = " . $magic_data->{$key}; 552 | } 553 | } 554 | 555 | # use @magic_to_fs table to check regexes against libmagic result 556 | foreach my $m2f_pair (@magic_to_fs) { 557 | 558 | # @magic_to_fs constant contains pairs of regex (to match libmagic) and filesystem if matched 559 | PiFlash::State::verbose() and say STDERR "get_fstype: check ".$m2f_pair->[0]; 560 | if ( $magic_data->{description} =~ $m2f_pair->[0] ) { 561 | if ( $m2f_pair->[1] == 1 ) { 562 | $fstype = $1; 563 | } else { 564 | $fstype = $m2f_pair->[1]; 565 | } 566 | last; 567 | } 568 | } 569 | } 570 | 571 | # return filesystem type string, or undef if not determined 572 | defined $fstype and chomp $fstype; 573 | PiFlash::State::verbose() and say STDERR "get_fstype($devpath) = " . ( $fstype // "undef" ); 574 | return $fstype; 575 | } 576 | 577 | 1; 578 | -------------------------------------------------------------------------------- /lib/PiFlash/MediaWriter.pm: -------------------------------------------------------------------------------- 1 | # PiFlash::MediaWriter - write to Raspberry Pi SD card installation with scriptable customization 2 | # by Ian Kluft 3 | 4 | # pragmas to silence some warnings from Perl::Critic 5 | ## no critic (Modules::RequireExplicitPackage) 6 | # This solves a catch-22 where parts of Perl::Critic want both package and use-strict to be first 7 | use strict; 8 | use warnings; 9 | use utf8; 10 | ## use critic (Modules::RequireExplicitPackage) 11 | 12 | package PiFlash::MediaWriter; 13 | 14 | use feature qw(say); 15 | use autodie; # report errors instead of silently continuing ("die" actions are used as exceptions - caught & reported) 16 | use Carp qw(carp croak); 17 | use Readonly; 18 | use Try::Tiny; 19 | use File::Basename; 20 | use File::Slurp qw(slurp); 21 | use File::Temp; 22 | use PiFlash::State; 23 | use PiFlash::Command; 24 | use PiFlash::Inspector; 25 | use PiFlash::Hook; 26 | 27 | # constants 28 | Readonly::Scalar my $extract_prefix => "extract_"; 29 | Readonly::Scalar my $dd_args => "bs=4M oflag=sync status=progress"; 30 | 31 | # ABSTRACT: write to Raspberry Pi SD card installation with scriptable customization 32 | 33 | =head1 SYNOPSIS 34 | 35 | PiFlash::MediaWriter::flash_device(); 36 | 37 | =head1 DESCRIPTION 38 | 39 | =head1 SEE ALSO 40 | 41 | L, L, L, L 42 | 43 | =head1 BUGS AND LIMITATIONS 44 | 45 | Report bugs via GitHub at L 46 | 47 | Patches and enhancements may be submitted via a pull request at L 48 | 49 | =cut 50 | 51 | # generate random hex digits 52 | sub random_hex 53 | { 54 | my $length = shift; 55 | my $hex = ""; 56 | while ( $length > 0 ) { 57 | my $chunk = ( $length > 4 ) ? 4 : $length; 58 | $length -= $chunk; 59 | $hex .= sprintf "%0*x", $chunk, int( rand( 16**$chunk ) ); 60 | } 61 | return $hex; 62 | } 63 | 64 | # generate a random UUID 65 | # 128 bits/32 hexadecimal digits, used to set a probably-unique UUID on an ext2/3/4 filesystem we created 66 | sub random_uuid 67 | { 68 | my $uuid; 69 | 70 | # start with our own contrived prefix for our UUIDs 71 | $uuid .= "314decaf-"; # "314" first digits of pi (as in RasPi), and "decaf" among few words from hex digits 72 | 73 | # next 4 digits are from lower 4 hex digits of current time (rolls over every 18 days) 74 | $uuid .= sprintf "%04x-", ( time & 0xffff ); 75 | 76 | # next 4 digits are the UUID format version (4 for random) and 3 random hex digits 77 | $uuid .= "4" . random_hex(3) . "-"; 78 | 79 | # next 4 digits are a UUID variant digit and 3 random hex digits 80 | $uuid .= ( sprintf "%x", 8 + int( rand(4) ) ) . random_hex(3) . "-"; 81 | 82 | # conclude with 8 random hex digits 83 | $uuid .= random_hex(12); 84 | 85 | return $uuid; 86 | } 87 | 88 | # generate a random label string 89 | # 11 characters, used to set a probably-unique label on a VFAT/ExFAT filesystem we created 90 | sub random_label 91 | { 92 | my $label = "RPI"; 93 | for ( my $i = 0 ; $i < 8 ; $i++ ) { 94 | my $num = int( rand(36) ); 95 | if ( $num <= 9 ) { 96 | $label .= chr( ord('0') + $num ); 97 | } else { 98 | $label .= chr( ord('A') + $num - 10 ); 99 | } 100 | } 101 | return $label; 102 | } 103 | 104 | # reread partition table, with retries if necessary 105 | sub reread_pt 106 | { 107 | my $reason = shift; 108 | 109 | # re-read partition table, use multiple tries if necessary 110 | my $tries = 10; 111 | while (1) { 112 | try { 113 | PiFlash::Command::cmd( 114 | "reread partition table for $reason", PiFlash::Command::prog("sudo"), 115 | PiFlash::Command::prog("blockdev"), "--rereadpt", 116 | PiFlash::State::output("path") 117 | ); 118 | }; 119 | 120 | # check for errors, retry if possible 121 | if ($@) { 122 | if ( ref $@ ) { 123 | 124 | # reference means unrecognized error - rethrow the exception 125 | croak $@; 126 | } elsif ( $@ =~ /exited with value 1/ ) { 127 | 128 | # exit status 1 means retry 129 | $tries--; 130 | if ( $tries > 0 ) { 131 | 132 | # wait a second and try again - sync may need to settle 133 | sleep 1; 134 | next; 135 | } 136 | 137 | # otherwise fail for repeated failed retries 138 | croak $@; 139 | } else { 140 | 141 | # other unrecognized error - rethrow the exception 142 | croak $@; 143 | } 144 | } 145 | 146 | # got through without an error - done 147 | last; 148 | } 149 | return; 150 | } 151 | 152 | # look up boot and root partition & filesystem info 153 | # save data in PiFlash::State::output 154 | sub get_sd_partitions 155 | { 156 | my $output = PiFlash::State::output(); 157 | ( exists $output->{partitions} ) and return; 158 | my @partitions = grep { /part\s*$/x } PiFlash::Command::cmd2str( 159 | "lsblk - find partitions", 160 | PiFlash::Command::prog("lsblk"), 161 | "--list", PiFlash::State::output("path") 162 | ); 163 | 164 | if (@partitions) { 165 | for ( my $i = 0 ; $i < scalar @partitions ; $i++ ) { 166 | $partitions[$i] =~ s/^([^\s]+)\s.*/$1/diex; 167 | } 168 | my $part_boot = $partitions[0]; 169 | my $num_root = scalar @partitions; 170 | my $part_root = $partitions[ $num_root - 1 ]; 171 | PiFlash::State::output( "num_boot", 0 ); 172 | PiFlash::State::output( "part_boot", $part_boot ); 173 | PiFlash::State::output( "fstype_boot", PiFlash::Inspector::get_fstype("/dev/$part_boot") ); 174 | PiFlash::State::output( "num_root", $num_root ); 175 | PiFlash::State::output( "part_root", $part_root ); 176 | PiFlash::State::output( "fstype_root", PiFlash::Inspector::get_fstype("/dev/$part_root") ); 177 | } 178 | PiFlash::State::output( "partitions", \@partitions ); 179 | 180 | if ( PiFlash::State::verbose() ) { 181 | print "get_sd_partitions: "; 182 | for my $key (qw(num_boot part_boot fstype_boot num_root part_root fstype_root)) { 183 | print "$key=" . ( PiFlash::State::output($key) // "undef" ) . " "; 184 | } 185 | print "\n"; 186 | } 187 | return; 188 | } 189 | 190 | # look up extractor function for archive file type 191 | sub extractor 192 | { 193 | my $type = shift; 194 | my $ext_func = __PACKAGE__->can( $extract_prefix . $type ); 195 | if ($ext_func) { 196 | return $ext_func; 197 | } 198 | croak __PACKAGE__ . " extractor($type) not implemented"; 199 | } 200 | 201 | # extractor for .img files 202 | sub extract_img 203 | { 204 | # flash raw image file to SD 205 | PiFlash::Command::cmd( 206 | "dd flash", 207 | PiFlash::Command::prog("sudo") . " " 208 | . PiFlash::Command::prog("dd") 209 | . " if=\"" 210 | . PiFlash::State::input("path") 211 | . "\" of=\"" 212 | . PiFlash::State::output("path") 213 | . "\" $dd_args" 214 | ); 215 | return; 216 | } 217 | 218 | # extractor for .zip files, including special handling for Raspberry Pi NOOBS package 219 | sub extract_zip 220 | { 221 | if ( PiFlash::State::has_input("NOOBS") ) { 222 | 223 | # format SD and copy NOOBS archive to it 224 | my $label = random_label(); 225 | PiFlash::State::output( "label", $label ); 226 | my $fstype = PiFlash::State::system("primary_fs"); 227 | if ( $fstype ne "vfat" ) { 228 | PiFlash::State->error("NOOBS requires VFAT filesystem, not in this kernel - need to load a module?"); 229 | } 230 | say "formatting $fstype filesystem for Raspberry Pi NOOBS system..."; 231 | PiFlash::Command::cmd( 232 | "write partition table", 233 | PiFlash::Command::prog("echo"), 234 | "type=c", "|", 235 | PiFlash::Command::prog("sudo"), 236 | PiFlash::Command::prog("sfdisk"), 237 | PiFlash::State::output("path") 238 | ); 239 | my @partitions = grep { /part\s*$/x } PiFlash::Command::cmd2str( 240 | "lsblk - find partitions", 241 | PiFlash::Command::prog("lsblk"), 242 | "--list", PiFlash::State::output("path") 243 | ); 244 | my $partition = "/dev/" . ( substr $partitions[0], 0, index( $partitions[0], ' ' ) ); 245 | PiFlash::Command::cmd( 246 | "format sd card", 247 | PiFlash::Command::prog("sudo"), 248 | PiFlash::Command::prog("mkfs.$fstype"), 249 | "-n", $label, $partition 250 | ); 251 | my $mntdir = PiFlash::State::system("media_dir") . "/piflash/sdcard"; 252 | PiFlash::Command::cmd( 253 | "reread partition table for NOOBS", PiFlash::Command::prog("sudo"), 254 | PiFlash::Command::prog("blockdev"), "--rereadpt", 255 | PiFlash::State::output("path") 256 | ); 257 | PiFlash::Command::cmd( 258 | "create mount point", 259 | PiFlash::Command::prog("sudo"), 260 | PiFlash::Command::prog("mkdir"), 261 | "-p", $mntdir 262 | ); 263 | 264 | # mount filesystem to unarchive NOOBS into it, then try/catch exceptions so it won't prevent unmounting 265 | PiFlash::Command::cmd( 266 | "mount SD card", 267 | PiFlash::Command::prog("sudo"), 268 | PiFlash::Command::prog("mount"), 269 | "-t", $fstype, "LABEL=$label", $mntdir 270 | ); 271 | try { 272 | PiFlash::Command::cmd( 273 | "unzip NOOBS contents", 274 | PiFlash::Command::prog("sudo"), 275 | PiFlash::Command::prog("unzip"), 276 | "-d", $mntdir, PiFlash::State::input("path") 277 | ); 278 | } catch { 279 | carp "continuing after NOOBS unarchive failed: $_"; 280 | }; 281 | PiFlash::Command::cmd( 282 | "unmount SD card", 283 | PiFlash::Command::prog("sudo"), 284 | PiFlash::Command::prog("umount"), $mntdir 285 | ); 286 | } else { 287 | 288 | # flash zip archive to SD 289 | PiFlash::Command::cmd( 290 | "unzip/dd flash", 291 | PiFlash::Command::prog("unzip") 292 | . " -p \"" 293 | . PiFlash::State::input("path") . "\" \"" 294 | . PiFlash::State::input("imgfile") . "\" | " 295 | . PiFlash::Command::prog("sudo") . " " 296 | . PiFlash::Command::prog("dd") 297 | . " of=\"" 298 | . PiFlash::State::output("path") 299 | . "\" $dd_args" 300 | ); 301 | } 302 | return; 303 | } 304 | 305 | # extractor for .img files 306 | sub extract_gz 307 | { 308 | # flash gzip-compressed image file to SD 309 | PiFlash::Command::cmd( 310 | "gunzip/dd flash", 311 | PiFlash::Command::prog("gunzip") 312 | . " --stdout \"" 313 | . PiFlash::State::input("path") . "\" | " 314 | . PiFlash::Command::prog("sudo") . " " 315 | . PiFlash::Command::prog("dd") 316 | . " of=\"" 317 | . PiFlash::State::output("path") 318 | . "\" $dd_args" 319 | ); 320 | return; 321 | } 322 | 323 | # extractor for .img files 324 | sub extract_xz 325 | { 326 | # flash xz-compressed image file to SD 327 | PiFlash::Command::cmd( 328 | "xz/dd flash", 329 | PiFlash::Command::prog("xz") 330 | . " --decompress --stdout \"" 331 | . PiFlash::State::input("path") . "\" | " 332 | . PiFlash::Command::prog("sudo") . " " 333 | . PiFlash::Command::prog("dd") 334 | . " of=\"" 335 | . PiFlash::State::output("path") 336 | . "\" $dd_args" 337 | ); 338 | return; 339 | } 340 | 341 | # flash the output device from the input file 342 | sub flash_device 343 | { 344 | # flash the device 345 | if ( PiFlash::State::has_input("imgfile") ) { 346 | 347 | # if we know an embedded image file name, use it in the start message 348 | say "flashing " 349 | . PiFlash::State::input("path") . " / " 350 | . PiFlash::State::input("imgfile") . " -> " 351 | . PiFlash::State::output("path"); 352 | } else { 353 | 354 | # print a start message with source and destination 355 | say "flashing " . PiFlash::State::input("path") . " -> " . PiFlash::State::output("path"); 356 | } 357 | say "wait for it to finish - this takes a while, progress not always indicated"; 358 | 359 | # look up and run extractor function 360 | my $input_type = PiFlash::State::input("type"); 361 | my $extractor_func = extractor($input_type); # throws exception if file type support not implemented 362 | $extractor_func->(); # throws exception on failure 363 | 364 | # sync IO buffers after write 365 | say "- synchronizing buffers"; 366 | PiFlash::Command::cmd( "sync", PiFlash::Command::prog("sync") ); 367 | 368 | # re-read partition table, use multiple tries if necessary 369 | reread_pt("post-sync"); 370 | get_sd_partitions(); 371 | my @partitions = PiFlash::State::output("partitions"); 372 | 373 | # check if there are any partitions before partition-dependent processing 374 | # protects from scenario (such as RISCOS) where whole-device filesystem has no partition table 375 | if (@partitions) { 376 | my $num_root = PiFlash::State::output("num_root"); 377 | my $part_root = PiFlash::State::output("part_root"); 378 | my $fstype_root = PiFlash::State::output("fstype_root"); 379 | 380 | # resize root filesystem if command-line flag is set 381 | # resize flag is silently ignored for NOOBS images because it will re-image and resize 382 | if ( PiFlash::State::has_cli_opt("resize") and not PiFlash::State::has_input("NOOBS") ) { 383 | say "- resizing the partition"; 384 | 385 | if ( defined $fstype_root ) { 386 | my @sfdisk_resize_input = (", +"); 387 | if ( $fstype_root =~ /^ext[234]/x ) { 388 | 389 | # ext2/3/4 filesystem can be resized 390 | PiFlash::Command::cmd2str( 391 | \@sfdisk_resize_input, "resize partition", 392 | PiFlash::Command::prog("sudo"), PiFlash::Command::prog("sfdisk"), 393 | "--quiet", "--no-reread", 394 | "-N", $num_root, 395 | PiFlash::State::output("path") 396 | ); 397 | say "- checking the filesystem"; 398 | PiFlash::Command::cmd2str( 399 | "filesystem check ($fstype_root)", 400 | PiFlash::Command::prog("sudo"), 401 | PiFlash::Command::prog("e2fsck"), 402 | "-fy", "/dev/$part_root" 403 | ); 404 | say "- resizing the filesystem"; 405 | PiFlash::Command::cmd2str( 406 | "resize filesystem", 407 | PiFlash::Command::prog("sudo"), 408 | PiFlash::Command::prog("resize2fs"), 409 | "/dev/$part_root" 410 | ); 411 | reread_pt("resize $fstype_root"); # re-read partition table, use multiple tries if necessary 412 | } elsif ( $fstype_root eq "btrfs" ) { 413 | 414 | # btrfs filesystem can be resized 415 | PiFlash::Command::cmd2str( 416 | \@sfdisk_resize_input, "resize partition", 417 | PiFlash::Command::prog("sudo"), PiFlash::Command::prog("sfdisk"), 418 | "--quiet", 419 | "-N", $num_root, 420 | PiFlash::State::output("path") 421 | ); 422 | say "- checking the filesystem"; 423 | PiFlash::Command::cmd2str( 424 | "filesystem check (btrfs)", 425 | PiFlash::Command::prog("sudo"), 426 | PiFlash::Command::prog("btrfs"), 427 | qw(check --progress), 428 | "/dev/$part_root" 429 | ); 430 | say "- resizing the filesystem"; 431 | my $mntdir = PiFlash::State::system("media_dir") . "/piflash/sdcard"; 432 | my $mnt_root = $mntdir . "/root"; 433 | PiFlash::Command::cmd( 434 | "create mount point for root fs", 435 | PiFlash::Command::prog("sudo"), 436 | PiFlash::Command::prog("mkdir"), 437 | "-p", $mnt_root 438 | ); 439 | 440 | say "- resizing the filesystem"; 441 | # BTRFS requires mounting filesystem to resize it (up to partition size) 442 | # mount filesystem, then try/catch exceptions so it won't prevent unmounting 443 | PiFlash::Command::cmd( 444 | "mount root", 445 | PiFlash::Command::prog("sudo"), 446 | PiFlash::Command::prog("mount"), 447 | qw(-t btrfs), "/dev/$part_root", $mnt_root 448 | ); 449 | try { 450 | PiFlash::Command::cmd2str( 451 | "resize filesystem", 452 | PiFlash::Command::prog("sudo"), 453 | PiFlash::Command::prog("btrfs"), 454 | qw(filesystem resize max), $mnt_root 455 | ); 456 | } catch { 457 | carp "continuing without resize after root BTRFS filesystem resize failed: $_"; 458 | }; 459 | PiFlash::Command::cmd( 460 | "unmount root fs", 461 | PiFlash::Command::prog("sudo"), 462 | PiFlash::Command::prog("umount"), $mnt_root 463 | ); 464 | 465 | # make system re-read partition table after changes 466 | reread_pt("resize $fstype_root"); # re-read partition table, use multiple tries if necessary 467 | } else { 468 | carp "unrecognized filesystem type $fstype_root - resize not attempted"; 469 | } 470 | } else { 471 | carp "unknown filesystem type - resize not attempted"; 472 | } 473 | } 474 | 475 | # check if any hooks are registered for filesystem access 476 | if ( PiFlash::Hook::has("fs_mount") ) { 477 | reread_pt("filesystem hooks"); # re-read partition table, use multiple tries if necessary 478 | get_sd_partitions(); 479 | my $fstype_boot = PiFlash::State::output("fstype_boot"); 480 | my $dev_boot = "/dev/" . PiFlash::State::output("part_boot"); 481 | my $dev_root = "/dev/" . PiFlash::State::output("part_root"); 482 | my $mntdir = PiFlash::State::system("media_dir") . "/piflash/sdcard"; 483 | my $mnt_boot = $mntdir . "/boot"; 484 | my $mnt_root = $mntdir . "/root"; 485 | PiFlash::Command::cmd( 486 | "create mount point for boot fs", 487 | PiFlash::Command::prog("sudo"), 488 | PiFlash::Command::prog("mkdir"), 489 | "-p", $mnt_boot 490 | ); 491 | PiFlash::Command::cmd( 492 | "create mount point for root fs", 493 | PiFlash::Command::prog("sudo"), 494 | PiFlash::Command::prog("mkdir"), 495 | "-p", $mnt_root 496 | ); 497 | 498 | # mount boot/root filesystems, then try/catch exceptions so it won't prevent unmounting 499 | try { 500 | PiFlash::Command::cmd( 501 | "mount boot fs", 502 | PiFlash::Command::prog("sudo"), 503 | PiFlash::Command::prog("mount"), 504 | "-t", $fstype_boot, $dev_boot, $mnt_boot 505 | ); 506 | try { 507 | PiFlash::Command::cmd( 508 | "mount root fs", 509 | PiFlash::Command::prog("sudo"), 510 | PiFlash::Command::prog("mount"), 511 | "-t", $fstype_root, $dev_root, $mnt_root 512 | ); 513 | try { 514 | PiFlash::Hook::fs_mount( { boot => $mnt_boot, root => $mnt_root } ); 515 | } catch { 516 | carp "continuing after exception in fs_mount hook: $_"; 517 | }; 518 | PiFlash::Command::cmd( 519 | "unmount root fs", 520 | PiFlash::Command::prog("sudo"), 521 | PiFlash::Command::prog("umount"), $mnt_root 522 | ); 523 | PiFlash::Command::cmd( 524 | "unmount boot fs", 525 | PiFlash::Command::prog("sudo"), 526 | PiFlash::Command::prog("umount"), $mnt_boot 527 | ); 528 | } catch { 529 | carp "continuing after exception mounting root for fs_mount hook: $_"; 530 | }; 531 | } catch { 532 | carp "continuing after exception mounting boot for fs_mount hook: $_"; 533 | }; 534 | } 535 | } 536 | 537 | # call hooks for optional post-install tweaks 538 | PiFlash::Hook::post_install(); 539 | 540 | # report that it's done 541 | say "done - it is safe to remove the SD card"; 542 | return; 543 | } 544 | 545 | 1; 546 | -------------------------------------------------------------------------------- /lib/PiFlash/Object.pm: -------------------------------------------------------------------------------- 1 | # PiFlash::Object - object functions for PiFlash classes 2 | # by Ian Kluft 3 | 4 | # pragmas to silence some warnings from Perl::Critic 5 | ## no critic (Modules::RequireExplicitPackage) 6 | # This solves a catch-22 where parts of Perl::Critic want both package and use-strict to be first 7 | use strict; 8 | use warnings; 9 | use utf8; 10 | ## use critic (Modules::RequireExplicitPackage) 11 | 12 | package PiFlash::Object; 13 | 14 | use autodie; # report errors instead of silently continuing ("die" actions are used as exceptions - caught & reported) 15 | use Carp qw(confess); 16 | 17 | # ABSTRACT:object functions for PiFlash classes 18 | 19 | =head1 SYNOPSIS 20 | 21 | package PiFlash::Example; 22 | use parent 'PiFlash::Object'; 23 | 24 | sub object_params 25 | ( 26 | return qw(name type); # and any other required object parameter names 27 | } 28 | 29 | my $obj = PiFlash::Example->new( {name => "foo", type => "bar"); 30 | 31 | =head1 DESCRIPTION 32 | 33 | PiFlash::Object was written so that L and L could inherit and share the same new() class method, rather than have similar and separate implementations. It isn't of interest to most PiFlash users. 34 | 35 | In order to use it, the class must define a class method called object_params() which returns a list of the required parameter names for each object of the class. 36 | 37 | =head1 SEE ALSO 38 | 39 | L, L, L 40 | 41 | =head1 BUGS AND LIMITATIONS 42 | 43 | Report bugs via GitHub at L 44 | 45 | Patches and enhancements may be submitted via a pull request at L 46 | 47 | =cut 48 | 49 | # new() - internal function to instantiate hook object 50 | # this should only be called from add() with coderef/caller/origin parameters 51 | sub new 52 | { 53 | my ( $class, $params, @args ) = @_; 54 | 55 | # instantiate an object of the class 56 | my $self = {}; 57 | bless $self, $class; 58 | 59 | # initialize parameters 60 | foreach my $key ( keys %$params ) { 61 | $self->{$key} = $params->{$key}; 62 | } 63 | 64 | # chack for missing required parameters 65 | my @missing; 66 | foreach my $required ( $class->object_params() ) { 67 | exists $self->{$required} or push @missing, $required; 68 | } 69 | if (@missing) { 70 | confess $class. "->new() missing required parameters: " . join( " ", @missing ); 71 | } 72 | 73 | # if init() class method exists, call it with any remaining parameters 74 | if ( $class->can("init") ) { 75 | $self->init(@args); 76 | } 77 | 78 | return $self; 79 | } 80 | 81 | 1; 82 | -------------------------------------------------------------------------------- /lib/PiFlash/Plugin.pm: -------------------------------------------------------------------------------- 1 | # PiFlash::Plugin - plugin extension interface for PiFlash 2 | # by Ian Kluft 3 | 4 | # pragmas to silence some warnings from Perl::Critic 5 | ## no critic (Modules::RequireExplicitPackage) 6 | # This solves a catch-22 where parts of Perl::Critic want both package and use-strict to be first 7 | use strict; 8 | use warnings; 9 | use utf8; 10 | ## use critic (Modules::RequireExplicitPackage) 11 | 12 | package PiFlash::Plugin; 13 | 14 | use autodie; # report errors instead of silently continuing ("die" actions are used as exceptions - caught & reported) 15 | use parent 'PiFlash::Object'; 16 | use PiFlash::State; 17 | use Module::Pluggable 18 | require => 1, 19 | search_path => [__PACKAGE__]; # RPM: perl-Module-Pluggable, DEB: libmodule-pluggable-perl 20 | 21 | # ABSTRACT: plugin extension interface for PiFlash 22 | 23 | =head1 SYNOPSIS 24 | 25 | package PiFlash::Plugin::Example; 26 | use parent 'PiFlash::Plugin'; 27 | 28 | # optional init class method - if defined it will be called upon creation of the plugin object 29 | sub init 30 | { 31 | my $self = shift; 32 | 33 | # perform any object initialization actions here 34 | $self->{data} = "value"; 35 | 36 | # example: subscribe to PiFlash::Hook callbacks 37 | PiFlash::Hook::add("fs_mount", sub { ... code to run on callback ... }); 38 | PiFlash::Hook::add("post_install", \&function_name); 39 | } 40 | 41 | # get a reference to the plugin's instance variable & data (same as $self in the init function) 42 | my $data = PiFlash::Plugin::Example->get_data; 43 | 44 | =head1 DESCRIPTION 45 | 46 | The PiFlash::Plugin module has class methods which manage all the plugins and 47 | instance methods which are the base class inherited by each plugin. L 48 | can be used to receive callback events at various stages of the PiFlash run. 49 | 50 | To create a plugin for PiFlash, write a new class under the namespace of PiFlash::Plugin, 51 | such as PiFlash::Plugin::Example. All PiFlash plugins must be named under and inherit 52 | from PiFlash::Plugin. Otherwise they will not be enabled or accessible. 53 | 54 | If the plugin class contains or inherits an init() method, it will be called when the 55 | plugin object is created. You don't need to write a new() routine, and shouldn't, because 56 | PiFlash::Plugin provides one which must be used by all plugins. That will be called by 57 | PiFlash during plugin initialization. 58 | 59 | =head1 SEE ALSO 60 | 61 | L, L, L, 62 | 63 | =head1 BUGS AND LIMITATIONS 64 | 65 | Report bugs via GitHub at L 66 | 67 | Patches and enhancements may be submitted via a pull request at L 68 | 69 | =cut 70 | 71 | # required parameter list 72 | # class method 73 | # used by PiFlash::Object for new() method 74 | sub object_params 75 | { 76 | return qw(name class); 77 | } 78 | 79 | # initialize enabled plugins 80 | # class method 81 | sub init_plugins 82 | { 83 | # get list of enabled plugins from command line and config file 84 | my %enabled; 85 | if ( PiFlash::State::has_cli_opt("plugin") ) { 86 | foreach my $plugin ( split( /[^\w:]+/x, PiFlash::State::cli_opt("plugin") // "" ) ) { 87 | next if $plugin eq ""; 88 | $plugin =~ s/^.*:://x; 89 | $enabled{$plugin} = 1; 90 | } 91 | } 92 | if ( PiFlash::State::has_config("plugin") ) { 93 | foreach my $plugin ( split( /[^\w:]+/x, PiFlash::State::config("plugin") // "" ) ) { 94 | next if $plugin eq ""; 95 | $plugin =~ s/^.*:://x; 96 | $enabled{$plugin} = 1; 97 | } 98 | } 99 | 100 | # for each enabled plugin, allocate state storage, load its config (if any) and run its init method 101 | my @plugins_available = PiFlash::Plugin->plugins(); 102 | foreach my $plugin (@plugins_available) { 103 | 104 | # fool function that it was called as class method 105 | # we don't call the subclass' method until we're sure the class is loaded 106 | # but we know it will inherit the method function from here 107 | my $modname = PiFlash::Plugin::get_modname($plugin); 108 | 109 | # check if the module is enabled by user from config or CLI 110 | if ( exists $enabled{$modname} ) { 111 | 112 | # load the plugin code if its symbol table doesn't already exist (not already defined by a loaded module) 113 | ( defined( *{ $plugin . "::" } ) ) or require $plugin; 114 | 115 | # verify it's a subclass of PiFlash::Plugin 116 | if ( $plugin->isa("PiFlash::Plugin") ) { 117 | 118 | # skip if its object/storage area exists 119 | if ( PiFlash::State::has_plugin($modname) ) { 120 | next; 121 | } 122 | 123 | # find any YAML documents addressed to this plugin from the config file 124 | my @data; 125 | my $plugin_docs = PiFlash::State::plugin("docs"); 126 | if ( exists $plugin_docs->{$modname} ) { 127 | push @data, ( "config" => $plugin_docs->{$modname} ); 128 | } 129 | 130 | # if the plugin class has an init() method, inherited PiFlash::Object->new() will call it 131 | PiFlash::State::plugin( $modname, $plugin->new( { name => $modname, class => $plugin, @data } ) ); 132 | } 133 | } 134 | } 135 | return; 136 | } 137 | 138 | # derive module name from class name 139 | # class method 140 | sub get_modname 141 | { 142 | my $class = shift; 143 | if ( $class =~ /^PiFlash::Plugin::([A-Z]\w+)/x ) { 144 | return $1; 145 | } 146 | return; 147 | } 148 | 149 | # find the data/instance for the plugin 150 | # class method 151 | sub get_data 152 | { 153 | my $class = shift; 154 | my $modname = $class->get_modname(); 155 | return PiFlash::State::plugin($modname); 156 | } 157 | 158 | 1; 159 | -------------------------------------------------------------------------------- /lib/PiFlash/State.pm: -------------------------------------------------------------------------------- 1 | # PiFlash::State - store program-site state information for PiFlash 2 | # by Ian Kluft 3 | # 4 | # the information stored here includes configuration,command-line arguments, system hardware inspection results, etc 5 | # 6 | 7 | # pragmas to silence some warnings from Perl::Critic 8 | ## no critic (Modules::RequireExplicitPackage) 9 | # This solves a catch-22 where parts of Perl::Critic want both package and use-strict to be first 10 | use strict; 11 | use warnings; 12 | use utf8; 13 | ## use critic (Modules::RequireExplicitPackage) 14 | 15 | # State class to hold program state, and print it all out in case of errors 16 | # this is a low-level package - it stores state data but at this level has no knowledge of what is being stored in it 17 | package PiFlash::State; 18 | 19 | use base 'Class::Singleton'; 20 | use autodie; 21 | use YAML::XS; # RPM: perl-YAML-LibYAML, DEB: libyaml-libyaml-perl 22 | use Carp qw(croak); 23 | 24 | # ABSTRACT: PiFlash::State class to store configuration, device info and program state 25 | 26 | =head1 SYNOPSIS 27 | 28 | # initialize: creates empty sub-objects and accessor functions as shown below 29 | PiFlash::State->init("system", "input", "output", "cli_opt", "log"); 30 | 31 | # better initialization - use PiFlash's state category list function 32 | my @categories = PiFlash::state_categories(); 33 | PiFlash::State->init(@categories); 34 | 35 | # core functions 36 | $bool_verbose_mode = PiFlash::State::verbose() 37 | $bool_logging_mode = PiFlash::State::logging() 38 | PiFlash::State::odump 39 | PiFlash::State->error("error message"); 40 | 41 | # system accessors 42 | my $system = PiFlash::State::system(); 43 | my $bool = PiFlash::State::has_system($key); 44 | my $value = PiFlash::State::system($key); 45 | PiFlash::State::system($key, $value); 46 | 47 | # input accessors 48 | my $input = PiFlash::State::input(); 49 | my $bool = PiFlash::State::has_input($key); 50 | my $value = PiFlash::State::input($key); 51 | PiFlash::State::input($key, $value); 52 | 53 | # output accessors 54 | my $output = PiFlash::State::output(); 55 | my $bool = PiFlash::State::has_output($key); 56 | my $value = PiFlash::State::output($key); 57 | PiFlash::State::output($key, $value); 58 | 59 | # cli_opt accessors 60 | my $cli_opt = PiFlash::State::cli_opt(); 61 | my $bool = PiFlash::State::has_cli_opt($key); 62 | my $value = PiFlash::State::cli_opt($key); 63 | PiFlash::State::cli_opt($key, $value); 64 | 65 | # log accessors 66 | my $log = PiFlash::State::log(); 67 | my $bool = PiFlash::State::has_log($key); 68 | my $value = PiFlash::State::log($key); 69 | PiFlash::State::log($key, $value); 70 | 71 | =head1 DESCRIPTION 72 | 73 | This class contains internal functions used by L to store command-line parameters, input & output file data, available device data and program logs. 74 | 75 | PiFlash uses the device info to refuse to write/destroy a device which is not an SD card. This provides a safeguard while using root permissions against a potential error which has happened where users have accidentally erased the wrong block device, losing a hard drive they wanted to keep. 76 | 77 | =head1 SEE ALSO 78 | 79 | L, L, L 80 | 81 | =head1 BUGS AND LIMITATIONS 82 | 83 | Report bugs via GitHub at L 84 | 85 | Patches and enhancements may be submitted via a pull request at L 86 | 87 | =cut 88 | 89 | # initialize class' singleton object from parameters 90 | # class method 91 | sub init 92 | { 93 | my ( $class, @args ) = @_; 94 | defined $class 95 | or croak "init: class parameter not received"; 96 | if ( $class ne __PACKAGE__ ) { 97 | 98 | # Arguably this should have been a class function and not a method. Since it's a method and user code 99 | # may call it, for compatibility that won't be changed now. Enforce use only for this class. 100 | croak "init() method serves only " . __PACKAGE__; 101 | } 102 | if ( __PACKAGE__->has_instance() ) { 103 | my $instance = __PACKAGE__->instance(); 104 | if ( ( scalar keys %$instance ) > 0 ) { 105 | return; # avoid overwriting existing data if called again 106 | } 107 | } 108 | 109 | # global security settings for YAML::XS parser 110 | # since PiFlash can run parts as root, we must not allow external code to be run without user authorization 111 | ## no critic (Variables::ProhibitPackageVars) 112 | $YAML::XS::LoadBlessed = 0; 113 | $YAML::XS::UseCode = 0; 114 | $YAML::XS::LoadCode = 0; 115 | ## critic (Variables::ProhibitPackageVars) 116 | 117 | # instantiate the state object as a singleton (only one instance in the system) 118 | my $self = __PACKAGE__->instance(); 119 | 120 | # loop through parameters adding each name as a top-level state hash and accessor functions 121 | while ( scalar @args > 0 ) { 122 | my $top_level_param = shift @args; 123 | 124 | # create top-level hash named for the parameter 125 | $self->{$top_level_param} = {}; 126 | 127 | # generate class accessor methods named for the parameter 128 | { 129 | ## no critic (ProhibitNoStrict) 130 | no strict qw(refs); 131 | 132 | # accessor fieldname() 133 | if ( not __PACKAGE__->can($top_level_param) ) { 134 | *{ __PACKAGE__ . "::" . $top_level_param } = sub { 135 | return __PACKAGE__->accessor( $top_level_param, @_ ); 136 | }; 137 | } 138 | 139 | # accessor has_fieldname() 140 | if ( not __PACKAGE__->can( "has_" . $top_level_param ) ) { 141 | *{ __PACKAGE__ . "::has_" . $top_level_param } = sub { 142 | return __PACKAGE__->has( $top_level_param, @_ ); 143 | }; 144 | } 145 | } 146 | } 147 | return; 148 | } 149 | 150 | # get top level state 151 | # This takes no parameters. It can be called as a class function or method. 152 | sub get_state 153 | { 154 | my ( $caller_package, $filename, $line ) = caller; 155 | if ( $caller_package ne __PACKAGE__ and $caller_package ne "PiFlash" ) { 156 | croak __PACKAGE__ . " internal-use-only method called by $caller_package at $filename line $line"; 157 | } 158 | return __PACKAGE__->instance(); 159 | } 160 | 161 | # state value get/set accessor 162 | # class method 163 | sub accessor 164 | { 165 | my ( $class, $top_level_param, $name, $value ) = @_; 166 | my $self = $class->get_state(); 167 | 168 | if ( defined $value ) { 169 | 170 | # got name & value - set the new value for name 171 | $self->{$top_level_param}{$name} = $value; 172 | return $value; 173 | } 174 | 175 | if ( defined $name ) { 176 | 177 | # got only name - return the value/ref of name 178 | return ( exists $self->{$top_level_param}{$name} ) 179 | ? $self->{$top_level_param}{$name} 180 | : undef; 181 | } 182 | 183 | # no name or value - return ref to top-level hash (top_level_parameter from init() context) 184 | return $self->{$top_level_param}; 185 | } 186 | 187 | # check if a top level state has a key 188 | # class method 189 | sub has 190 | { 191 | my ( $class, $top_level_param, $name ) = @_; 192 | my $self = $class->get_state(); 193 | return ( ( exists $self->{$top_level_param} ) and ( exists $self->{$top_level_param}{$name} ) ); 194 | } 195 | 196 | # return boolean value for verbose mode 197 | sub verbose 198 | { 199 | return PiFlash::State::cli_opt("verbose") // 0; 200 | } 201 | 202 | # return boolean value for logging mode (recording run data without printing verbose messages, intended for testing) 203 | sub logging 204 | { 205 | return PiFlash::State::cli_opt("logging") // 0; 206 | } 207 | 208 | # dump data structure recursively, part of verbose/logging state output 209 | # intended as a lightweight equivalent of Data::Dumper without requiring installation of an extra package 210 | # object method 211 | sub odump 212 | { 213 | my ( $obj, $level ) = @_; 214 | if ( not defined $obj ) { 215 | 216 | # bail out for undefined value 217 | return ""; 218 | } 219 | if ( not ref $obj ) { 220 | 221 | # process plain scalar 222 | return ( " " x $level ) . "[value]" . $obj . "\n"; 223 | } 224 | if ( ref $obj eq "SCALAR" ) { 225 | 226 | # process scalar reference 227 | return ( " " x $level ) . ( $$obj // "undef" ) . "\n"; 228 | } 229 | if ( ref $obj eq "HASH" 230 | or ref $obj eq __PACKAGE__ 231 | or ( ref $obj =~ /^PiFlash::/x and $obj->isa("PiFlash::Object") ) ) 232 | { 233 | # process hash reference 234 | my $str = ""; 235 | foreach my $key ( sort { lc $a cmp lc $b } keys %$obj ) { 236 | if ( ref $obj->{$key} ) { 237 | $str .= ( " " x $level ) . "$key:" . "\n"; 238 | $str .= odump( $obj->{$key}, $level + 1 ); 239 | } else { 240 | $str .= ( " " x $level ) . "$key: " . ( $obj->{$key} // "undef" ) . "\n"; 241 | } 242 | } 243 | return $str; 244 | } 245 | if ( ref $obj eq "ARRAY" ) { 246 | 247 | # process array reference 248 | my $str = ""; 249 | foreach my $entry (@$obj) { 250 | if ( ref $entry ) { 251 | $str .= odump( $entry, $level + 1 ); 252 | } else { 253 | $str .= ( " " x $level ) . "$entry\n"; 254 | } 255 | } 256 | return $str; 257 | } 258 | if ( ref $obj eq "CODE" ) { 259 | 260 | # process function reference 261 | return ( " " x $level ) . "[function]$obj" . "\n"; 262 | } 263 | 264 | # other references/unknown type 265 | my $type = ref $obj; 266 | return ( " " x $level ) . "[$type]$obj" . "\n"; 267 | } 268 | 269 | # die/exception with verbose state dump 270 | # class method 271 | sub error 272 | { 273 | my ( $class, $message ) = @_; 274 | croak "error: " . $message 275 | . ( ( verbose() or logging() ) ? "\nProgram state dump...\n" . odump( __PACKAGE__->get_state(), 0 ) : "" ); 276 | } 277 | 278 | # read YAML configuration file 279 | sub read_config 280 | { 281 | my $filepath = shift; 282 | 283 | # if the provided file name exists and ... 284 | if ( -f $filepath ) { 285 | 286 | # capture as many YAML documents as can be parsed from the configuration file 287 | my @yaml_docs = eval { YAML::XS::LoadFile($filepath); }; 288 | if ($@) { 289 | __PACKAGE__->error( __PACKAGE__ . "::read_config error reading $filepath: $@" ); 290 | } 291 | 292 | # save the first YAML document as the configuration 293 | my $yaml_config = shift @yaml_docs; 294 | if ( ref $yaml_config eq "HASH" ) { 295 | 296 | # if it's a hash, then use all its mappings in PiFlash::State::config 297 | my $pif_state = __PACKAGE__->get_state(); 298 | $pif_state->{config} = $yaml_config; 299 | } else { 300 | 301 | # otherwise save the reference in a config entry called config 302 | PiFlash::State::config( "config", $yaml_config ); 303 | } 304 | 305 | # if any other YAML documents were parsed, save them as a list in a config called "docs" 306 | # these are available for plugins but not currently defined 307 | if (@yaml_docs) { 308 | 309 | # save the YAML doc structures as a list 310 | PiFlash::State::config( "docs", \@yaml_docs ); 311 | 312 | # the first doc must be the table of contents with a list of metadata about following docs 313 | # others after that are categorized by the plugin name in the metadata 314 | my $toc = $yaml_docs[0]; 315 | if ( ref $toc eq "ARRAY" ) { 316 | PiFlash::State::plugin( "docs", { toc => $toc } ); 317 | my $docs = PiFlash::State::plugin("docs"); 318 | for ( my $i = 1 ; $i < scalar @yaml_docs ; $i++ ) { 319 | ( $i <= scalar @$toc ) or next; 320 | if ( ref $yaml_docs[$i] eq "HASH" and exists $toc->[ $i - 1 ]{type} ) { 321 | my $type = $toc->[ $i - 1 ]{type}; 322 | $docs->{$type} = $yaml_docs[$i]; 323 | } 324 | } 325 | } 326 | } 327 | } 328 | return; 329 | } 330 | 331 | 1; 332 | -------------------------------------------------------------------------------- /perlcritic.rc: -------------------------------------------------------------------------------- 1 | severity = harsh 2 | verbose = [%p] %m at line %l, column %c. %e (Severity: %s)\n 3 | include = RequirePodSections 4 | color-severity-lowest = bright_blue 5 | color-severity-low = bright_green 6 | color-severity-medium = bright_yellow 7 | color-severity-high = rgb530 8 | color-severity-highest = bright_red 9 | 10 | [TestingAndDebugging::RequireUseStrict] 11 | equivalent_modules = Moo Modern::Perl 12 | 13 | [TestingAndDebugging::RequireUseWarnings] 14 | equivalent_modules = Moo Modern::Perl 15 | 16 | [Documentation::RequirePodSections] 17 | lib_sections = NAME | VERSION | SYNOPSIS | DESCRIPTION | BUGS AND LIMITATIONS | AUTHOR | COPYRIGHT AND LICENSE 18 | script_sections = NAME | USAGE | DESCRIPTION | EXIT STATUS | BUGS AND LIMITATIONS | AUTHOR | COPYRIGHT AND LICENSE 19 | 20 | [Subroutines::ProhibitExcessComplexity] 21 | max_mccabe = 20 22 | 23 | [Subroutines::RequireFinalReturn] 24 | terminal_methods = throw error 25 | terminal_funcs = error croak 26 | 27 | -------------------------------------------------------------------------------- /perltidy.rc: -------------------------------------------------------------------------------- 1 | --cuddled-else 2 | --maximum-line-length=120 3 | --utf8 4 | --output-line-ending=unix 5 | --continuation-indentation=4 6 | --opening-sub-brace-on-new-line 7 | --indent-block-comments 8 | --static-block-comments 9 | --nooutdent-long-lines 10 | -------------------------------------------------------------------------------- /t/000_platform.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # 002_platform.t - check for supported platform (initially Linux only) 3 | 4 | use strict; 5 | use warnings; 6 | use Config; 7 | 8 | use Test::More tests => 1; # last test to print 9 | 10 | is( $Config{osname}, "linux", "PiFlash only runs on Linux" ); 11 | 12 | 1; 13 | -------------------------------------------------------------------------------- /t/001_module_load.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # 001module_load.t - basic test that the modules all load 3 | 4 | use strict; 5 | use warnings; 6 | use Test::More; 7 | 8 | my @classes = qw( 9 | PiFlash::Command 10 | PiFlash::Hook 11 | PiFlash::Inspector 12 | PiFlash::MediaWriter 13 | PiFlash::Object 14 | PiFlash::Plugin 15 | PiFlash::State 16 | PiFlash 17 | ); 18 | plan tests => scalar @classes; 19 | 20 | foreach my $class (@classes) { 21 | require_ok($class); 22 | } 23 | 24 | 1; 25 | -------------------------------------------------------------------------------- /t/010_PiFlash_State.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # 010PiFlash_State.t - tests for PiFlash::State module 3 | 4 | use strict; 5 | use warnings; 6 | use autodie; 7 | 8 | use Test::More; 9 | use PiFlash; 10 | use PiFlash::State; 11 | 12 | # initialize program state storage 13 | my @top_level_params = PiFlash::state_categories(); 14 | PiFlash::State->init(@top_level_params); 15 | my @cli_params = ( "verbose", "logging" ); 16 | plan tests => 1 + ( scalar @top_level_params ) * 10 + ( scalar @cli_params ) * 3; 17 | 18 | # get ref to PiFlash::State singleton instance 19 | my $pif_state = PiFlash::State->instance(); 20 | 21 | # make sure we're getting enough data from PiFlash::state_categories() 22 | ok( ( scalar @top_level_params ) >= 8, "PiFlash::state_categories provides at least 8 entries" ); 23 | 24 | # test top-level program state entries 25 | foreach my $tlp_name (@top_level_params) { 26 | 27 | # dynamic method existence tests 28 | can_ok( "PiFlash::State", $tlp_name ); 29 | can_ok( "PiFlash::State", "has_" . $tlp_name ); 30 | 31 | # top-level hash existence tests 32 | ok( exists $pif_state->{$tlp_name}, "state{$tlp_name} exists" ); 33 | is( ref $pif_state->{$tlp_name}, "HASH", "state{$tlp_name} is a hash ref" ); 34 | my $hashref = $PiFlash::State::{$tlp_name}(); 35 | is( ref $hashref, "HASH", "HASH ref for $tlp_name" ); 36 | is( scalar keys %$hashref, 0, "empty hash for $tlp_name by default" ); 37 | 38 | # accessor tests 39 | ## no critic (ProhibitStringyEval) 40 | my $test_sub_accessor = sub { return eval "PiFlash::State::$tlp_name(\@_)"; }; 41 | my $test_sub_has = sub { return eval "PiFlash::State::has_$tlp_name(\@_)"; }; 42 | ## use critic (ProhibitStringyEval) 43 | ok( !$test_sub_has->("foo"), "$tlp_name\{foo\} undefined by default" ); 44 | $test_sub_accessor->( "foo", 1 ); 45 | ok( $test_sub_has->("foo"), "$tlp_name\{foo\} defined after assignment" ); 46 | is( $test_sub_has->("foo"), 1, "$tlp_name\{foo\} correct value after assignment" ); 47 | is( scalar keys %$hashref, 1, "1 entry in $tlp_name hash after test" ); 48 | } 49 | 50 | # CLI-specific parameter (verbose/logging) tests 51 | foreach my $cli_param (@cli_params) { 52 | ## no critic (ProhibitStringyEval) 53 | my $test_sub_cli_param = sub { return eval "PiFlash::State::$cli_param()"; }; 54 | ## use critic (ProhibitStringyEval) 55 | is( $test_sub_cli_param->(), 0, "$cli_param is false by default" ); 56 | PiFlash::State::cli_opt( $cli_param, 1 ); 57 | is( $test_sub_cli_param->(), 1, "$cli_param is true when set to 1" ); 58 | PiFlash::State::cli_opt( $cli_param, 0 ); 59 | is( $test_sub_cli_param->(), 0, "$cli_param is false when set to 0" ); 60 | } 61 | 62 | 1; 63 | -------------------------------------------------------------------------------- /t/011_PiFlash_Command.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # 011PiFlash_Command.t - tests for PiFlash::Command module 3 | 4 | use strict; 5 | use warnings; 6 | use autodie; 7 | 8 | use Test::More; 9 | use PiFlash; 10 | use PiFlash::State; 11 | use PiFlash::Command; 12 | use Data::Dumper; 13 | 14 | # detect debug mode from environment 15 | # run as "DEBUG=1 perl -Ilib t/011PiFlash_Command.t" to get debug output to STDERR 16 | my $debug_mode = exists $ENV{DEBUG}; 17 | 18 | # expand parameter variable names in parameters 19 | sub expand 20 | { 21 | my $varhash = shift; 22 | my $varname = shift; 23 | my $prog = PiFlash::State::system("prog"); 24 | my $varname_re = join( '|', ( keys %$varhash, keys %$prog ) ); 25 | my $value = $varhash->{$varname} // ""; 26 | if ( ref $value eq "ARRAY" ) { 27 | for ( my $i = 0 ; $i < scalar @$value ; $i++ ) { 28 | ( defined $value->[$i] ) or next; 29 | while ( $value->[$i] =~ /\$($varname_re)/ ) { 30 | my $match = $1; 31 | my $subst = $varhash->{$match} // $prog->{$match}; 32 | $value->[$i] =~ s/\$$match/$subst/g; 33 | } 34 | } 35 | } else { 36 | while ( $value =~ /\$($varname_re)/ ) { 37 | my $match = $1; 38 | my $subst = $varhash->{$match} // $prog->{$match}; 39 | $value =~ s/\$$match/$subst/g; 40 | } 41 | } 42 | return $value; 43 | } 44 | 45 | # find a program's expected location to verify PiFlash::Command::prog() 46 | sub find_prog 47 | { 48 | my $prog = shift; 49 | 50 | foreach my $path ( "/usr/bin", "/sbin", "/usr/sbin", "/bin" ) { 51 | if ( -x "$path/$prog" ) { 52 | return "$path/$prog"; 53 | } 54 | } 55 | 56 | # return undef value by default 57 | } 58 | 59 | # test PiFlash::Command::prog() 60 | sub test_prog 61 | { 62 | my $params = shift; # hash structure of test parameters 63 | my $prog = PiFlash::State::system("prog"); 64 | my $progname = expand( $params, "progname" ); 65 | my ( $progpath, $exception ); 66 | 67 | # set test-fixture data in environment if provided 68 | my %saved_env; 69 | my $need_restore_env = 0; 70 | if ( ( exists $params->{env} ) and ( ref $params->{env} eq "HASH" ) ) { 71 | foreach my $key ( keys %{ $params->{env} } ) { 72 | if ( exists $ENV{$key} ) { 73 | $saved_env{$key} = $ENV{$key}; 74 | } 75 | $ENV{$key} = $params->{env}{$key}; 76 | } 77 | $need_restore_env = 1; 78 | } 79 | 80 | # run the prog function to locate the selected program's path 81 | $debug_mode and warn "prog test for $progname"; 82 | eval { $progpath = PiFlash::Command::prog($progname) }; 83 | $exception = $@; 84 | 85 | # test and report results 86 | my $test_set = "path " . $params->{test_set_suffix}; 87 | if ($debug_mode) { 88 | if ( exists $prog->{$progname} ) { 89 | warn "comparing " . $prog->{$progname} . " eq $progpath"; 90 | } else { 91 | warn "$progname cache missing\n" . Dumper($prog); 92 | } 93 | } 94 | if ( !exists $params->{expected_exception} ) { 95 | is( $prog->{$progname}, $progpath, "$test_set: path in cache: $progname -> " . ( $progpath // "(undef)" ) ); 96 | if ( defined $progpath ) { 97 | ok( -x $progpath, "$test_set: path points to executable program" ); 98 | } else { 99 | fail("$test_set: path points to executable program (undefined)"); 100 | } 101 | is( $exception, '', "$test_set: no exceptions" ); 102 | 103 | # verify program is in expected location 104 | my $expected_path = find_prog($progname); 105 | my $envprog = PiFlash::Command::envprog($progname); 106 | my $reason = "default"; 107 | if ( exists $ENV{$envprog} and -x $ENV{$envprog} ) { 108 | if ( -x $expected_path ) { 109 | $reason = "default, ignore ENV{$envprog}"; 110 | } else { 111 | $expected_path = $ENV{$envprog}; 112 | $reason = "ENV{$envprog}"; 113 | } 114 | } 115 | is( $progpath, $expected_path, "$test_set: expected at $expected_path by $reason" ); 116 | } else { 117 | ok( !exists $prog->{$progname}, "$test_set: path not in cache as expected after exception" ); 118 | is( $progpath, undef, "$test_set: path undefined after expected exception" ); 119 | my $expected_exception = expand( $params, "expected_exception" ); 120 | like( $exception, qr/$expected_exception/, "$test_set: expected exception" ); 121 | pass("$test_set: $progname has no location due to expected exception"); 122 | } 123 | 124 | # restore environment and remove test-fixture data from it 125 | if ($need_restore_env) { 126 | foreach my $key ( keys %{ $params->{env} } ) { 127 | if ( exists $ENV{$key} ) { 128 | $ENV{$key} = $saved_env{$key}; 129 | } else { 130 | delete $ENV{$key}; 131 | } 132 | } 133 | } 134 | } 135 | 136 | # function to check log results in last command in log 137 | sub check_cmd_log 138 | { 139 | my $key = shift; 140 | my $expected_value = shift; 141 | my $params = shift; 142 | 143 | # fetch the log value for comparison 144 | my $log = PiFlash::State::log("cmd"); 145 | my $log_entry = $log->[ ( scalar @$log ) - 1 ]; 146 | my $log_value = $log_entry->{$key}; 147 | 148 | # if it's an array, loop through to compare elements 149 | if ( ref $expected_value eq "ARRAY" ) { 150 | if ( ref $log_value ne "ARRAY" ) { 151 | 152 | # mismatch if both are not array refs 153 | $debug_mode and warn "mismatch ref type: log value not ARRAY"; 154 | return 0; 155 | } 156 | if ( $log_value->[ ( scalar @$log_value ) - 1 ] eq "" ) { 157 | 158 | # eliminate blank last line for comparison due to appended newline 159 | pop @$log_value; 160 | } 161 | if ( ( scalar @$expected_value ) != ( scalar @$log_value ) ) { 162 | 163 | # mismatch if result arrays are different numbers of lines 164 | $debug_mode 165 | and warn "mismatch array length " . ( scalar @$expected_value ) . " != " . ( scalar @$log_value ); 166 | return 0; 167 | } 168 | my $i; 169 | for ( $i = 0 ; $i < scalar @$expected_value ; $i++ ) { 170 | if ( $expected_value->[$i] ne $log_value->[$i] ) { 171 | 172 | # mismatch if any lines aren't equal 173 | $debug_mode and warn "mismatch line: $expected_value->[$i] ne $log_value->[$i]"; 174 | return 0; 175 | } 176 | } 177 | return 1; # if we got here, it's a match 178 | } 179 | 180 | # if both values are undefined, that's a special case match because eq operator doesn't like them 181 | if ( ( !defined $expected_value ) and ( !defined $log_value ) ) { 182 | return 1; 183 | } 184 | 185 | # with previous case tested, they are not both undefined; so undef in either is a mismatch 186 | if ( ( !defined $expected_value ) or ( !defined $log_value ) ) { 187 | $debug_mode and warn "mismatch on one undef"; 188 | return 0; 189 | } 190 | 191 | # otherwise compare values 192 | chomp $log_value; 193 | if ( ( exists $params->{regex} ) and $params->{regex} ) { 194 | return $expected_value =~ qr/$log_value/; 195 | } 196 | return $expected_value eq $log_value; 197 | } 198 | 199 | # test PiFlash::Command::fork_exec() 200 | # function to run a set of tests on a fork_exec command 201 | sub test_fork_exec 202 | { 203 | my $params = shift; # hash structure of test parameters 204 | 205 | my ( $out, $err, $exception ); 206 | my $cmdname = expand( $params, "cmdname" ); 207 | my $cmdline = expand( $params, "cmdline" ); 208 | 209 | # run command 210 | $debug_mode and warn "running '$cmdname' as: " . join( " ", @$cmdline ); 211 | eval { ( $out, $err ) = PiFlash::Command::fork_exec( ( $params->{input} // () ), $cmdname, @$cmdline ) }; 212 | $exception = $@; 213 | 214 | # tweak captured data for comparison 215 | chomp $out if defined $out; 216 | chomp $err if defined $err; 217 | 218 | # test and report results 219 | my $test_set = "fork_exec " . $params->{test_set_suffix}; 220 | ok( check_cmd_log( "cmdname", $cmdname ), "$test_set: command name logged: $cmdname" ); 221 | ok( check_cmd_log( "cmdline", $cmdline ), "$test_set: command line logged: " . join( " ", @$cmdline ) ); 222 | if ( exists $params->{expected_exception} ) { 223 | my $expected_exception = expand( $params, "expected_exception" ); 224 | like( $exception, qr/$expected_exception/, "$test_set: expected exception" ); 225 | } else { 226 | is( $exception, '', "$test_set: no exceptions" ); 227 | } 228 | if ( exists $params->{expected_signal} ) { 229 | my $expected_signal = expand( $params, "expected_signal" ); 230 | ok( check_cmd_log( "signal", $expected_signal, { regex => 1 } ), "$test_set: $expected_signal" ); 231 | } else { 232 | ok( check_cmd_log( "signal", undef ), "$test_set: no signals" ); 233 | } 234 | ok( check_cmd_log( "returncode", $params->{returncode} ), "$test_set: returncode is $params->{returncode}" ); 235 | is( $out, $params->{expected_out}, "$test_set: output capture match" ); 236 | ok( check_cmd_log( "out", $params->{expected_out} ), "$test_set: output log match" ); 237 | is( $err, $params->{expected_err}, "$test_set: error capture match" ); 238 | ok( check_cmd_log( "err", $params->{expected_err} ), "$test_set: error log match" ); 239 | } 240 | 241 | # 242 | # lists of tests 243 | # 244 | 245 | # strings used for tests 246 | # test string: uses Latin text for intention to appear obviously out of place outside the context of these tests 247 | my $test_string = "Ad astra per alas porci"; 248 | 249 | # (what it means: Latin for "to the stars on the wings of a pig", motto used by author John Steinbeck after a teacher 250 | # once told him he'd only be a successful writer when pigs fly) 251 | 252 | # test PiFlash::Command::prog() and check for existence of prerequisite programs for following tests 253 | my $trueprog = find_prog("true"); 254 | if ( !defined $trueprog ) { 255 | BAIL_OUT("This system doesn't have a 'true' program? Tests were counting on one to be there."); 256 | } 257 | 258 | # test fixtures for program path tests 259 | # these also fill the path cache for commands used in later fork-exec tests 260 | my @prog_tests = ( 261 | { progname => "true" }, 262 | { progname => "false" }, 263 | { progname => "cat" }, 264 | { progname => "echo" }, 265 | { progname => "sh" }, 266 | { progname => "kill" }, 267 | { 268 | progname => "xyzzy-notfound", 269 | expected_exception => "unknown secure location for \$progname", 270 | }, 271 | { 272 | env => { XYZZY_NOTFOUND_PROG => $trueprog }, 273 | progname => "xyzzy-notfound", 274 | }, 275 | { 276 | env => { ECHO_PROG => $trueprog }, 277 | progname => "echo", 278 | }, 279 | ); 280 | 281 | # data for fork_exec() test sets 282 | my @fork_exec_tests = ( 283 | 284 | # test capturing true result with fork_exec() 285 | # runs command: true 286 | { 287 | cmdname => "true command", 288 | cmdline => [q{$true}], 289 | returncode => 0, 290 | expected_out => undef, 291 | expected_err => undef, 292 | }, 293 | 294 | # test capturing false result with fork_exec() 295 | # runs command: false 296 | # exception expected during this test 297 | { 298 | cmdname => "false command", 299 | cmdline => [q{$false}], 300 | returncode => 1, 301 | expected_out => undef, 302 | expected_err => undef, 303 | expected_exception => "\$cmdname command exited with value \$returncode", 304 | }, 305 | 306 | # test capturing output of a fixed string from a program with fork_exec() 307 | # runs command: echo "$test_string" 308 | { 309 | cmdname => "echo string to stdout", 310 | cmdline => [ q{$echo}, $test_string ], 311 | returncode => 0, 312 | expected_out => $test_string, 313 | expected_err => undef, 314 | }, 315 | 316 | # test capturing an error output 317 | { 318 | cmdname => "echo string to stderr", 319 | cmdline => [ q{$sh}, "-c", qq{\$echo $test_string >&2} ], 320 | returncode => 0, 321 | expected_out => undef, 322 | expected_err => $test_string, 323 | }, 324 | 325 | # test sending input and receiving the same string back as output from a program with fork_exec() 326 | # runs command: cat 327 | # input piped to the program: $test_string 328 | { 329 | input => [$test_string], 330 | cmdname => "cat input to output", 331 | cmdline => [q{$cat}], 332 | returncode => 0, 333 | expected_out => $test_string, 334 | expected_err => undef, 335 | }, 336 | 337 | # test sending input and receiving the same string back in stderr with fork_exec() 338 | # runs command: cat 339 | # input piped to the program: $test_string 340 | { 341 | input => [$test_string], 342 | cmdname => "cat input to stderr", 343 | cmdline => [ q{$sh}, "-c", qq{\$cat >&2} ], 344 | returncode => 0, 345 | expected_out => undef, 346 | expected_err => $test_string, 347 | }, 348 | 349 | # test capturing an error 1 result 350 | # exception expected during this test 351 | { 352 | cmdname => "return errorcode \$returncode", 353 | cmdline => [ q{$sh}, "-c", q{exit $returncode} ], 354 | returncode => 1, 355 | expected_out => undef, 356 | expected_err => undef, 357 | expected_exception => "\$cmdname command exited with value \$returncode", 358 | }, 359 | 360 | # test capturing an error 2 result 361 | # exception expected during this test 362 | { 363 | cmdname => "return errorcode \$returncode", 364 | cmdline => [ q{$sh}, "-c", q{exit $returncode} ], 365 | returncode => 2, 366 | expected_out => undef, 367 | expected_err => undef, 368 | expected_exception => "\$cmdname command exited with value \$returncode", 369 | }, 370 | 371 | # test capturing an error 3 result 372 | # exception expected during this test 373 | { 374 | cmdname => "return errorcode \$returncode", 375 | cmdline => [ q{$sh}, "-c", q{exit $returncode} ], 376 | returncode => 3, 377 | expected_out => undef, 378 | expected_err => undef, 379 | expected_exception => "\$cmdname command exited with value \$returncode", 380 | }, 381 | 382 | # test capturing an error 255 result 383 | # exception expected during this test 384 | { 385 | cmdname => "return errorcode \$returncode", 386 | cmdline => [ q{$sh}, "-c", q{exit $returncode} ], 387 | returncode => 255, 388 | expected_out => undef, 389 | expected_err => undef, 390 | expected_exception => "\$cmdname command exited with value \$returncode", 391 | }, 392 | 393 | # test receiving signal 1 SIGHUP 394 | { 395 | cmdname => "signal \$signal SIGHUP", 396 | cmdline => [ q{$sh}, "-c", q{$kill -$signal $$} ], 397 | signal => 1, 398 | returncode => 0, 399 | expected_out => undef, 400 | expected_err => undef, 401 | expected_exception => "\$cmdname command died with signal \$signal,", 402 | expected_signal => "signal \$signal", 403 | }, 404 | 405 | # test receiving signal 2 SIGINT 406 | { 407 | cmdname => "signal \$signal SIGINT", 408 | cmdline => [ q{$sh}, "-c", q{$kill -$signal $$} ], 409 | signal => 2, 410 | returncode => 0, 411 | expected_out => undef, 412 | expected_err => undef, 413 | expected_exception => "\$cmdname command died with signal \$signal,", 414 | expected_signal => "signal \$signal", 415 | }, 416 | 417 | # test receiving signal 9 SIGKILL 418 | { 419 | cmdname => "signal \$signal SIGKILL", 420 | cmdline => [ q{$sh}, "-c", q{$kill -$signal $$} ], 421 | signal => 9, 422 | returncode => 0, 423 | expected_out => undef, 424 | expected_err => undef, 425 | expected_exception => "\$cmdname command died with signal \$signal,", 426 | expected_signal => "signal \$signal", 427 | }, 428 | 429 | # test receiving signal 15 SIGTERM 430 | { 431 | cmdname => "signal \$signal SIGTERM", 432 | cmdline => [ q{$sh}, "-c", q{$kill -$signal $$} ], 433 | signal => 15, 434 | returncode => 0, 435 | expected_out => undef, 436 | expected_err => undef, 437 | expected_exception => "\$cmdname command died with signal \$signal,", 438 | expected_signal => "signal \$signal", 439 | }, 440 | ); 441 | 442 | plan tests => 1 + ( scalar @prog_tests ) * 4 + ( scalar @fork_exec_tests ) * 9; 443 | 444 | # initialize program state storage 445 | my @top_level_params = PiFlash::state_categories(); 446 | PiFlash::State->init(@top_level_params); 447 | PiFlash::State::cli_opt( "logging", 1 ); # logging required to keep logs of commands (like verbose but no output) 448 | 449 | # test forking a simple process that returns a true value using fork_child() 450 | { 451 | my $pid = PiFlash::Command::fork_child( 452 | sub { 453 | # in child process 454 | return 0; # 0 = success on exit of a program; test is successful if received by parent process 455 | } 456 | ); 457 | waitpid( $pid, 0 ); 458 | my $returncode = $? >> 8; 459 | is( $returncode, 0, "simple fork test" ); 460 | } 461 | 462 | # run fork_exec() tests 463 | PiFlash::Command::prog(); # init cache 464 | { 465 | my $count = 0; 466 | foreach my $prog_test (@prog_tests) { 467 | $count++; 468 | $prog_test->{test_set_suffix} = $count; 469 | test_prog($prog_test); 470 | } 471 | } 472 | 473 | # use prog cache from previous tests to check for existence of prerequisite programs for following tests 474 | my $prog = PiFlash::State::system("prog"); 475 | my @prog_names = qw(true false cat echo sh kill); 476 | my @missing; 477 | foreach my $progname (@prog_names) { 478 | if ( !exists $prog->{$progname} ) { 479 | push @missing, $progname; 480 | } 481 | } 482 | if (@missing) { 483 | BAIL_OUT( "missing command required for tests: " . join( " ", @missing ) ); 484 | } 485 | 486 | # run fork_exec() tests 487 | { 488 | my $count = 0; 489 | foreach my $fe_test (@fork_exec_tests) { 490 | $count++; 491 | $fe_test->{test_set_suffix} = $count; 492 | test_fork_exec($fe_test); 493 | } 494 | } 495 | 496 | $debug_mode and warn PiFlash::State::odump( PiFlash::State::get_state(), 0 ); 497 | 498 | 1; 499 | -------------------------------------------------------------------------------- /t/020_config_yaml.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # 020config_yaml.t - tests for YAML configuration files 3 | 4 | use strict; 5 | use warnings; 6 | use autodie; 7 | use Test::More; 8 | use File::Basename; 9 | use PiFlash::State; 10 | use YAML::XS; 11 | use Data::Dumper; 12 | 13 | # detect debug mode from environment 14 | # run as "DEBUG=1 perl -Ilib t/011PiFlash_Command.t" to get debug output to STDERR 15 | my $debug_mode = exists $ENV{DEBUG}; 16 | 17 | # function with tests to run on each test input file 18 | sub yaml_tests 19 | { 20 | my $filepath = shift; 21 | my $flags = shift; 22 | if ( !exists $flags->{bad} ) { 23 | $flags->{good} = 1; # if not bad, add good flag so it shows up on the flag summary string 24 | } 25 | my $flag_str = join " ", sort keys %$flags; 26 | 27 | # clear config in PiFlash::State 28 | my $pif_state = PiFlash::State->instance(); 29 | $pif_state->{config} = {}; 30 | 31 | # read the config file 32 | eval { PiFlash::State::read_config($filepath); }; 33 | 34 | # run tests 35 | my $config = PiFlash::State::config(); 36 | $debug_mode and warn "debug: config:\n" . Dumper($pif_state); 37 | if ( !exists $flags->{bad} ) { 38 | is( "$@", '', "$filepath 1 ($flag_str): no exceptions" ); 39 | isnt( scalar keys %$config, 0, "$filepath 2 ($flag_str): non-empty config" ); 40 | 41 | # direct load the config file and store it like in PiFlash::State::read_config for comparison 42 | # if it's a map, use it directly 43 | # otherwise save it in a config element called config 44 | # if there are more YAML documents in the file, save them in an array ref in a config called "docs" 45 | my @direct_load = eval { YAML::XS::LoadFile($filepath); }; 46 | my $doc = shift @direct_load; 47 | if ( ref $doc ne "HASH" ) { 48 | $doc = { config => $doc }; 49 | } 50 | if (@direct_load) { 51 | $doc->{docs} = \@direct_load; 52 | } 53 | $debug_mode and warn "debug: compare\n" . Dumper($doc); 54 | is_deeply( $config, $doc, "$filepath 3 ($flag_str): content match" ); 55 | 56 | # perform YAML document tests when table of contents (TOC) flag is enabled 57 | # this tests how we use YAML documents as attachments for plugins 58 | # these extra tests are counted in the $toc_total 59 | if ( exists $flags->{toc} and $flags->{toc} ) { 60 | my $toc = shift @direct_load; 61 | is( ref $toc, "ARRAY", "$filepath 4 ($flag_str): TOC doc is a list" ); 62 | 63 | # check if plugin-typed YAML document attachments are stored correctly by plugin name 64 | my $docs_ok = 1; 65 | my $plugin_docs = PiFlash::State::plugin("docs"); 66 | for ( my $i = 0 ; $i < scalar @direct_load ; $i++ ) { 67 | ( $i < scalar @$toc ) or next; 68 | my $doc = $direct_load[$i]; 69 | my $type = $toc->[$i]{type}; 70 | ( defined $type ) or next; 71 | if ( ref $doc eq "HASH" ) { 72 | 73 | # check if the storage for the plugin's data exists 74 | if ( !exists $plugin_docs->{$type} ) { 75 | $docs_ok = 0; 76 | $debug_mode and print STDERR "020_config_yaml.t debug: no $type in plugin_docs\n"; 77 | last; 78 | } 79 | if ( ref $plugin_docs->{$type} ne "HASH" ) { 80 | $docs_ok = 0; 81 | $debug_mode and print STDERR "020_config_yaml.t debug: $type not a HASH ref\n"; 82 | last; 83 | } 84 | 85 | # for brevity we only compare keys between each source/destination set of hashes 86 | # so test data should use different keys for different plugins' data 87 | my $dest_str = join( " ", sort keys %{ $plugin_docs->{$type} } ); 88 | my $src_str = join( " ", sort keys %$doc ); 89 | if ( join( " ", $dest_str ne $src_str ) ) { 90 | $docs_ok = 0; 91 | $debug_mode and print STDERR "020_config_yaml.t debug: ($dest_str) ne ($src_str)\n"; 92 | last; 93 | } 94 | } 95 | } 96 | ok( $docs_ok, "$filepath 5 ($flag_str): plugin docs saved by name" ); 97 | } 98 | } else { 99 | isnt( "$@", '', "$filepath 1 ($flag_str): expected exception" ); 100 | } 101 | } 102 | 103 | # initialize program state storage 104 | my @top_level_params = ( "config", "plugin" ); 105 | PiFlash::State->init(@top_level_params); 106 | 107 | # read list of test input files from subdirectory with same basename as this script 108 | my $input_dir = "t/test-inputs/" . basename( $0, ".t" ); 109 | if ( !-d $input_dir ) { 110 | BAIL_OUT("can't find test inputs directory: expected $input_dir"); 111 | } 112 | opendir( my $dh, $input_dir ) or BAIL_OUT("can't open $input_dir directory"); 113 | my @files = sort grep { /^[^.]/ and -f "$input_dir/$_" } readdir($dh); 114 | closedir $dh; 115 | 116 | # load test metadata 117 | my @test_metadata = YAML::XS::LoadFile("$input_dir/000-test-metadata.yml"); 118 | my $metadata; 119 | if ( ref $test_metadata[0] eq "HASH" ) { 120 | $metadata = $test_metadata[0]; 121 | } 122 | 123 | # count files by good and bad YAML syntax 124 | my $good_total = 0; 125 | my $bad_total = 0; 126 | my $toc_total = 0; 127 | foreach my $file (@files) { 128 | my $flags = {}; 129 | if ( $metadata and exists $metadata->{$file} ) { 130 | if ( ref $metadata->{$file} eq "HASH" ) { 131 | $flags = $metadata->{$file}; 132 | } 133 | } 134 | if ( exists $flags->{bad} ) { 135 | $bad_total++; 136 | } else { 137 | $good_total++; 138 | if ( exists $flags->{toc} ) { 139 | $toc_total++; 140 | } 141 | } 142 | } 143 | 144 | # compute number of tests: (flags are read from 000-test-metadata.yml) 145 | # 1 test for files marked with "bad" flag 146 | # 3 tests for files with good syntax 147 | # 2 extra tests on files marked with the "toc" (table of contents) flag 148 | plan tests => 1 * $bad_total + 3 * $good_total + 2 * $toc_total; 149 | 150 | # run yaml_tests() for each file 151 | foreach my $file (@files) { 152 | my $flags = {}; 153 | if ( $metadata and exists $metadata->{$file} ) { 154 | if ( ref $metadata->{$file} eq "HASH" ) { 155 | $flags = $metadata->{$file}; 156 | } 157 | } 158 | yaml_tests( "$input_dir/$file", $flags ); 159 | } 160 | 161 | 1; 162 | -------------------------------------------------------------------------------- /t/021_plugin.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # 021_plugin.t - tests for PiFlash plugin interface 3 | 4 | use strict; 5 | use warnings; 6 | use autodie; 7 | use Test::More; 8 | use File::Basename; 9 | use PiFlash; 10 | use PiFlash::State; 11 | use Data::Dumper; 12 | 13 | # detect debug mode from environment 14 | # run as "DEBUG=1 perl -Ilib t/021_plugin.t" to get debug output to STDERR 15 | my $debug_mode = exists $ENV{DEBUG}; 16 | 17 | # base class for plugin testing and 3 test classes that inhert from it 18 | package TestBase { 19 | use parent 'PiFlash::Plugin'; 20 | 21 | # init class method is part of the plugin interface 22 | # called from PiFlash::Object->new() via PiFlash::Plugin->init_plugins() 23 | sub init 24 | { 25 | my $self = shift; 26 | 27 | # save data indicating which class/subclass was here 28 | $self->{class} = ref $self; 29 | $self->{status} = "enabled"; 30 | } 31 | }; 32 | 33 | package PiFlash::Plugin::Test1 { 34 | our @ISA = 'TestBase'; 35 | }; 36 | 37 | package PiFlash::Plugin::Test2 { 38 | our @ISA = 'TestBase'; 39 | }; 40 | 41 | package PiFlash::Plugin::Test3 { 42 | our @ISA = 'TestBase'; 43 | }; 44 | 45 | # initialize program state storage 46 | my @top_level_params = qw(cli_opt config plugin); 47 | PiFlash::State->init(@top_level_params); 48 | 49 | # function with tests to run enabled/disabled combinations of test classes 50 | sub plugin_tests 51 | { 52 | my $filepath = shift; 53 | my $bits = shift; 54 | my $mode = shift; 55 | 56 | # clear cli_opt/plugin/config in PiFlash::State 57 | my $pif_state = PiFlash::State->instance(); 58 | foreach my $category (@top_level_params) { 59 | $pif_state->{$category} = {}; 60 | } 61 | 62 | # read the config file 63 | # must do this before setting configs to load modules, otherwise it would overwrite those configs 64 | eval { PiFlash::State::read_config($filepath); }; 65 | if ($@) { 66 | 67 | # do not design errors into the config files for plugin tests 68 | # do that in 020_config_yaml.t which should be done before this test script 69 | BAIL_OUT("plugin config file $filepath threw exception $@"); 70 | } 71 | 72 | # enable selected test plugin modules 73 | my @plugins; 74 | for ( my $modnum = 0 ; $modnum < scalar @$bits ; $modnum++ ) { 75 | if ( $bits->[$modnum] ) { 76 | push @plugins, sprintf "Test%d", $modnum + 1; 77 | } 78 | } 79 | if (@plugins) { 80 | my $plugin_str = join( ",", @plugins ); 81 | $debug_mode and print STDERR "debug plugin_tests: plugins(" . join( "", @$bits ) . "): $plugin_str\n"; 82 | if ( $mode eq "cli" ) { 83 | PiFlash::State::cli_opt( "plugin", $plugin_str ); 84 | } elsif ( $mode eq "cfg" ) { 85 | PiFlash::State::config( "plugin", $plugin_str ); 86 | } else { 87 | BAIL_OUT( "unknown test mode: '" . ( $mode // "undef" ) . "'" ); 88 | } 89 | } 90 | my $test_name = $mode . join( "", @$bits ); 91 | 92 | # initialize the plugins 93 | eval { PiFlash::Plugin->init_plugins(); }; 94 | 95 | # run tests 96 | my $plugin_data = PiFlash::State::plugin(); 97 | is( "$@", '', "$filepath/$test_name 1: no exceptions" ); 98 | for ( my $modnum = 0 ; $modnum < scalar @$bits ; $modnum++ ) { 99 | my $modname = sprintf "Test%d", $modnum + 1; 100 | my $plugin_class = "PiFlash::Plugin::" . $modname; 101 | my $plugin_obj = $plugin_class->get_data(); 102 | my $subtest = $modnum * 2 + 2; 103 | if ( $bits->[$modnum] ) { 104 | is( $plugin_obj->{status}, "enabled", "$filepath/$test_name/$modnum " . ($subtest) . ": enabled" ); 105 | is_deeply( 106 | $plugin_obj->{config}, 107 | $plugin_data->{docs}{$modname}, 108 | "$filepath/$test_name/$modnum " . ( $subtest + 1 ) . ": data match" 109 | ); 110 | } else { 111 | ok( !PiFlash::State::has_plugin($modname), "$filepath/$test_name/$modnum " . ($subtest) . ": disabled" ); 112 | pass( "$filepath/$test_name/$modnum " . ( $subtest + 1 ) . ": no data" ) 113 | ; # always missing if module is missing 114 | } 115 | } 116 | $debug_mode and print STDERR "debug plugin_tests: " . Dumper($pif_state); 117 | } 118 | 119 | # read list of test input files from subdirectory with same basename as this script 120 | my $input_dir = "t/test-inputs/" . basename( $0, ".t" ); 121 | if ( !-d $input_dir ) { 122 | BAIL_OUT("can't find test inputs directory: expected $input_dir"); 123 | } 124 | opendir( my $dh, $input_dir ) or BAIL_OUT("can't open $input_dir directory"); 125 | my @files = sort grep { /^[^.]/ and -f "$input_dir/$_" } readdir($dh); 126 | closedir $dh; 127 | 128 | # compute number of tests: 129 | # 8 combinations of enabled/disabled plugins for 3 test classes (2^3) to check for interference between plugins 130 | # x 2 passes enabling plugins from CLI or config 131 | # x 7 tests per file 132 | # x n files 133 | plan tests => 8 * 2 * 7 * ( scalar @files ); 134 | 135 | # run plugin_tests() for each file 136 | foreach my $file (@files) { 137 | for ( my $i = 0 ; $i < 8 ; $i++ ) { 138 | 139 | # use $i's binary bits to make an array of true/false enabled state for 3 test modules 140 | my @bits; 141 | for ( my $bit = 2 ; $bit >= 0 ; $bit-- ) { 142 | push @bits, $i & ( 2**$bit ) ? 1 : 0; 143 | } 144 | 145 | # run each test mode (enabling plugins from CLI or config) 146 | foreach my $mode (qw(cli cfg)) { 147 | plugin_tests( "$input_dir/$file", \@bits, $mode ); 148 | } 149 | } 150 | } 151 | 152 | 1; 153 | -------------------------------------------------------------------------------- /t/022_cmdline.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # 022_cmdline.t - tests for PiFlash command line option processing 3 | 4 | use strict; 5 | use warnings; 6 | use autodie; 7 | use Test::More; 8 | use File::Basename; 9 | use PiFlash; 10 | use PiFlash::State; 11 | use Data::Dumper; 12 | 13 | # detect debug mode from environment 14 | # run as "DEBUG=1 perl -Ilib t/022_cmdline.t" to get debug output to STDERR 15 | my $debug_mode = exists $ENV{DEBUG}; 16 | 17 | # initialize program state storage 18 | my @top_level_params = PiFlash::state_categories(); 19 | 20 | # initial ordered tests for each case 21 | my %ordered_tests = ( 22 | result => sub { 23 | my ( $test_set_str, $expected, $value ) = @_; 24 | is( $value, $expected, "$test_set_str " . ( $expected ? "successful result" : "expected failure" ) ); 25 | }, 26 | exception => sub { 27 | my ( $test_set_str, $expected, $value ) = @_; 28 | ok( $value =~ $expected, "$test_set_str expected exception: $expected" ); 29 | }, 30 | ); 31 | 32 | # evaluate expression on state data after running test case 33 | sub state_expr 34 | { 35 | my $test_key = shift; 36 | my $expr_desc = shift; 37 | 38 | if ( ref $expr_desc ne "HASH" ) { 39 | BAIL_OUT( "invalid test: expression description must be a hash - got a " 40 | . ( ( ref $expr_desc eq "" ) ? "scalar" : ref $expr_desc ) ); 41 | } 42 | my $path = $expr_desc->{path}; 43 | my $op = $expr_desc->{op}; 44 | my $expect = $expr_desc->{expect} // ""; 45 | 46 | # find the state data by path 47 | my $description = join( "/", @$path ) . " $op $expect"; 48 | $debug_mode and print STDERR "debug state_expr $description\n"; 49 | my $top_level_param = shift @$path; 50 | my $pos = PiFlash::State->accessor($top_level_param); 51 | foreach my $key (@$path) { 52 | if ( ref $pos eq "HASH" and exists $pos->{$key} ) { 53 | $pos = $pos->{$key}; 54 | } else { 55 | $debug_mode and say STDERR "debug state_expr: $key not found in " . join( "/", $top_level_param, @$path ); 56 | return ( $description, 0 ); 57 | } 58 | } 59 | 60 | # run the expression 61 | my $result; 62 | $debug_mode and print STDERR "debug state_expr pos=" . ( ( defined $pos ) ? Dumper($pos) : "undef\n" ); 63 | if ( $op eq "has" ) { 64 | $result = ( ref $pos eq "HASH" and exists $pos->{$expect} ); 65 | } elsif ( $op eq "hasnt" ) { 66 | $result = ( ref $pos ne "HASH" or not exists $pos->{$expect} ); 67 | } elsif ( $op eq "eq" ) { 68 | $result = $pos eq $expect; 69 | } elsif ( $op eq "ne" ) { 70 | $result = $pos ne $expect; 71 | } elsif ( $op eq "le" ) { 72 | $result = $pos le $expect; 73 | } elsif ( $op eq "ge" ) { 74 | $result = $pos ge $expect; 75 | } elsif ( $op eq "==" ) { 76 | $result = $pos == $expect; 77 | } elsif ( $op eq "!=" ) { 78 | $result = $pos != $expect; 79 | } elsif ( $op eq "<=" ) { 80 | $result = $pos <= $expect; 81 | } elsif ( $op eq ">=" ) { 82 | $result = $pos >= $expect; 83 | } elsif ( $op eq "empty" ) { 84 | $result = ( ref $pos eq "HASH" and scalar( keys %$pos ) == 0 ); 85 | } else { 86 | BAIL_OUT("invalid test: unrecognized expression operation $op"); 87 | } 88 | return ( $description, $result ); 89 | } 90 | 91 | # function with tests to run on command line options, verifying contents of saved state data 92 | sub cmdline_tests 93 | { 94 | my $test_set_str = shift; 95 | my $cmdline = shift; 96 | my $tests = shift; 97 | 98 | # set up for test - clear state, set CLI params 99 | my $pif_state = PiFlash::State->instance(); 100 | %$pif_state = (); # reset contents so init() will see it as empty and start over 101 | PiFlash::State->init(@top_level_params); 102 | 103 | # run command line test case 104 | my %values; 105 | eval { PiFlash::process_cli($cmdline); }; 106 | $values{exception} = $@; 107 | $values{result} = ( $values{exception} ? 0 : 1 ); # true if no exceptions 108 | if ($debug_mode) { 109 | if ( not $values{result} ) { 110 | print STDERR "debug cmdline_tests $test_set_str values " . Dumper( \%values ); 111 | } 112 | print STDERR "debug cmdline_tests $test_set_str: cmdline = " . join( " ", @$cmdline ) . "\n"; 113 | print STDERR "debug cmdline_tests $test_set_str: " . Dumper($pif_state); 114 | } 115 | 116 | # use command line results for tests 117 | 118 | # run initial ordered tests first, if they exist in the test list 119 | my %tests_done; 120 | foreach my $test_key (qw(result exception)) { 121 | if ( exists $tests->{$test_key} ) { 122 | $ordered_tests{$test_key}->( $test_set_str, $tests->{$test_key}, $values{$test_key} ); 123 | $tests_done{$test_key} = 1; 124 | } 125 | } 126 | 127 | # then run remaining unordered tests in alphabetical order 128 | foreach my $test_key ( sort keys %$tests ) { 129 | exists $tests_done{$test_key} and next; 130 | if ( $test_key =~ /^data[0-9]+$/ ) { 131 | my ( $description, $is_ok ) = state_expr( $test_key, $tests->{$test_key} ); 132 | ok( $is_ok, "$test_set_str/$test_key $description" ); 133 | } else { 134 | BAIL_OUT("invalid test: $test_set_str unrecognized test name: $test_key"); 135 | } 136 | } 137 | } 138 | 139 | # command line test cases 140 | my $input_dir = "t/test-inputs/" . basename( $0, ".t" ); 141 | my $filename_that_exists = $input_dir . "/a_file_that_exists"; 142 | my $filename_that_doesnt_exist = $input_dir . "/a_file_that_doesnt_exist"; 143 | my @test_cases = ( 144 | [ 145 | [], 146 | { 147 | result => 0, 148 | exception => 'missing argument', 149 | data00 => { path => [qw(cli_opt)], op => "empty" }, 150 | data01 => { path => [qw(config)], op => "empty" }, 151 | data02 => { path => [qw(hook)], op => "empty" }, 152 | data03 => { path => [qw(input)], op => "empty" }, 153 | data04 => { path => [qw(log)], op => "empty" }, 154 | data05 => { path => [qw(output)], op => "empty" }, 155 | data06 => { path => [qw(plugin)], op => "empty" }, 156 | data07 => { path => [qw(system)], op => "empty" }, 157 | } 158 | ], 159 | [ 160 | ["--version"], 161 | { 162 | result => 1, 163 | data00 => { path => [qw(cli_opt)], op => "has", expect => "version" }, 164 | data01 => { path => [qw(cli_opt version)], op => "==", expect => 1 }, 165 | } 166 | ], 167 | [ 168 | ["--sdsearch"], 169 | { 170 | result => 1, 171 | data00 => { path => [qw(cli_opt)], op => "has", expect => "sdsearch" }, 172 | data01 => { path => [qw(cli_opt sdsearch)], op => "==", expect => 1 }, 173 | } 174 | ], 175 | [ 176 | ["--help"], 177 | { 178 | result => 1, 179 | data00 => { path => [qw(cli_opt)], op => "has", expect => "help" }, 180 | data01 => { path => [qw(cli_opt help)], op => "==", expect => 1 }, 181 | } 182 | ], 183 | [ 184 | ["--foo"], 185 | { 186 | result => 0, 187 | exception => 'Unknown option: foo', 188 | data00 => { path => [qw(cli_opt)], op => "hasnt", expect => "foo" }, 189 | } 190 | ], 191 | [ 192 | [ "--test", "skip_block_check=1", $filename_that_exists, $filename_that_doesnt_exist ], 193 | { 194 | result => 1, 195 | data00 => { path => [qw(cli_opt)], op => "has", expect => "test" }, 196 | data01 => { path => [qw(cli_opt test)], op => "has", expect => "skip_block_check" }, 197 | data02 => { path => [qw(cli_opt test skip_block_check)], op => "==", expect => 1 }, 198 | } 199 | ], 200 | [ 201 | [ $filename_that_exists, $filename_that_doesnt_exist, "--test", "skip_block_check=1" ], 202 | { 203 | result => 1, 204 | data00 => { path => [qw(cli_opt)], op => "has", expect => "test" }, 205 | data01 => { path => [qw(cli_opt test)], op => "has", expect => "skip_block_check" }, 206 | data02 => { path => [qw(cli_opt test skip_block_check)], op => "==", expect => 1 }, 207 | } 208 | ], 209 | [ 210 | [ "--test", "skip_block_check=1", $filename_that_doesnt_exist, $filename_that_doesnt_exist ], 211 | { 212 | result => 0, 213 | exception => 'source file.*does not exist', 214 | data00 => { path => [qw(cli_opt)], op => "has", expect => "test" }, 215 | data01 => { path => [qw(cli_opt test)], op => "has", expect => "skip_block_check" }, 216 | data02 => { path => [qw(cli_opt test skip_block_check)], op => "==", expect => 1 }, 217 | } 218 | ], 219 | [ 220 | [ $filename_that_exists, $filename_that_doesnt_exist ], 221 | { 222 | result => 0, 223 | exception => 'destination device.*does not exist', 224 | data00 => { path => [qw(cli_opt)], op => "empty" }, 225 | } 226 | ], 227 | [ 228 | [ "--test", "skip_block_check=1", "--resize", $filename_that_exists, $filename_that_doesnt_exist ], 229 | { 230 | result => 1, 231 | data01 => { path => [qw(cli_opt)], op => "has", expect => "resize" }, 232 | data02 => { path => [qw(cli_opt resize)], op => "==", expect => 1 }, 233 | } 234 | ], 235 | [ 236 | [ 237 | "--test", "skip_block_check=1", "--config", $filename_that_exists, 238 | $filename_that_exists, $filename_that_doesnt_exist 239 | ], 240 | { 241 | result => 1, 242 | data00 => { path => [qw(cli_opt)], op => "has", expect => "config" }, 243 | data01 => { path => [qw(cli_opt config)], op => "eq", expect => $filename_that_exists }, 244 | } 245 | ], 246 | ); 247 | 248 | # compute number of tests: 249 | # n test cases 250 | # x tests per case 251 | my $total_tests = 0; 252 | foreach my $test_case (@test_cases) { 253 | my $tests = $test_case->[1]; 254 | $total_tests += keys %$tests; 255 | } 256 | plan tests => $total_tests; 257 | 258 | # run command-line tests 259 | my $counter = 0; 260 | foreach my $test_case (@test_cases) { 261 | if ( ref $test_case ne "ARRAY" ) { 262 | BAIL_OUT("test case data is not an array"); 263 | } 264 | my $test_set_str = sprintf( "%03d", $counter++ ); 265 | cmdline_tests( $test_set_str, @$test_case ); 266 | } 267 | 268 | 1; 269 | -------------------------------------------------------------------------------- /t/test-inputs/020_config_yaml/000-test-metadata.yml: -------------------------------------------------------------------------------- 1 | %YAML 1.1 2 | --- 3 | # metadata about tests, and this file is also used as plain YAML to run one set of tests 4 | "002-dup-yaml.yml": 5 | bad: true 6 | "005-toc.yml": 7 | toc: true 8 | "006-toc.yml": 9 | toc: true 10 | "007-toc.yml": 11 | toc: true 12 | "008-toc.yml": 13 | toc: true 14 | "009-toc.yml": 15 | toc: true 16 | -------------------------------------------------------------------------------- /t/test-inputs/020_config_yaml/001-simple.yml: -------------------------------------------------------------------------------- 1 | This: top level mapping 2 | is: 3 | - a 4 | - YAML 5 | - document 6 | -------------------------------------------------------------------------------- /t/test-inputs/020_config_yaml/002-dup-yaml.yml: -------------------------------------------------------------------------------- 1 | %YAML 1.1 2 | %YAML 1.1 3 | error: duplicate YAML tags 4 | -------------------------------------------------------------------------------- /t/test-inputs/020_config_yaml/003-multi-doc.yml: -------------------------------------------------------------------------------- 1 | key1: value1 2 | key2: value2 3 | --- 4 | 2nd document 5 | --- 6 | 3rd document 7 | -------------------------------------------------------------------------------- /t/test-inputs/020_config_yaml/004-scalar.yml: -------------------------------------------------------------------------------- 1 | simple scalar string 2 | -------------------------------------------------------------------------------- /t/test-inputs/020_config_yaml/005-toc.yml: -------------------------------------------------------------------------------- 1 | foo: bar 2 | --- 3 | - type: Test1 4 | - type: Test2 5 | - type: Test3 6 | --- 7 | data: Test1 8 | foo: bar 9 | --- 10 | data: Test2 11 | ping: pong 12 | --- 13 | data: Test3 14 | -------------------------------------------------------------------------------- /t/test-inputs/020_config_yaml/006-toc.yml: -------------------------------------------------------------------------------- 1 | # test more TOC entries than attachments 2 | foo: bar 3 | --- 4 | - type: Test1 5 | - type: Test2 6 | - type: Test3 7 | - type: Test4 8 | --- 9 | data: Test1 10 | foo: bar 11 | --- 12 | data: Test2 13 | ping: pong 14 | --- 15 | data: Test3 16 | -------------------------------------------------------------------------------- /t/test-inputs/020_config_yaml/007-toc.yml: -------------------------------------------------------------------------------- 1 | # test fewer TOC entries than attachments 2 | foo: bar 3 | --- 4 | - type: Test1 5 | - type: Test2 6 | --- 7 | data: Test1 8 | foo: bar 9 | --- 10 | data: Test2 11 | ping: pong 12 | --- 13 | data: Test3 14 | -------------------------------------------------------------------------------- /t/test-inputs/020_config_yaml/008-toc.yml: -------------------------------------------------------------------------------- 1 | # test with TOC and only one of three plugins has an attachment 2 | foo: bar 3 | --- 4 | - type: Test1 5 | --- 6 | data: Test1 7 | foo: bar 8 | ping: pong 9 | -------------------------------------------------------------------------------- /t/test-inputs/020_config_yaml/009-toc.yml: -------------------------------------------------------------------------------- 1 | # test with TOC and only two of three plugins have an attachment 2 | foo: bar 3 | --- 4 | - type: Test1 5 | - type: Test2 6 | --- 7 | data: Test1 8 | foo: bar 9 | ping: pong 10 | --- 11 | data: Test2 12 | blarg: 13 | - one 14 | - two 15 | - three 16 | -------------------------------------------------------------------------------- /t/test-inputs/021_plugin/000-no-docs.yml: -------------------------------------------------------------------------------- 1 | foo: bar 2 | -------------------------------------------------------------------------------- /t/test-inputs/021_plugin/001-multi-doc.yml: -------------------------------------------------------------------------------- 1 | foo: bar 2 | --- 3 | - type: Test1 4 | - type: Test2 5 | - type: Test3 6 | --- 7 | data: Test1 8 | --- 9 | data: Test2 10 | --- 11 | data: Test3 12 | -------------------------------------------------------------------------------- /t/test-inputs/022_cmdline/a_file_that_exists: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/ikluft/piflash/a3771d78f19fd94f75a3491d2d472c48e3b25190/t/test-inputs/022_cmdline/a_file_that_exists --------------------------------------------------------------------------------