├── INSTALL.txt ├── TROUBLESHOOTING.txt ├── README.txt ├── rifec.config ├── COPYING └── rifec.pl /INSTALL.txt: -------------------------------------------------------------------------------- 1 | How to install and run RIFEC 2 | ============================ 3 | 4 | The script has some dependencies, all of which should be easily 5 | installable from CPAN or through your package manager. See the 6 | "Dependencies" section below for a list of which packages you need. 7 | 8 | Once you have downloaded the tarball (or checked out the directory) 9 | from github, all you need to do is edit the config file to tell it 10 | about your cards, where you want your images to be saved, etc. The 11 | example config file "rifec.config" contains a commented example 12 | configuration. 13 | 14 | Run the script with a single "--help" parameter to get a short help 15 | text on usage. 16 | 17 | If run without the --config=FILE parameter, rifec.pl will look for a 18 | config file named "rifec.config" in the current directory (the 19 | directory you are located in when calling it - not the directory where 20 | the script is located). 21 | 22 | See the file TROUBLESHOOTING.txt for information about troubleshooting 23 | this program. 24 | 25 | 26 | Dependencies 27 | ============ 28 | 29 | In addition to the core modules normally distributed with Perl 30 | installations, these are the main dependencies of this script: 31 | 32 | /bin/tar (can be located elsewhere) 33 | Config::IniFiles 34 | HTTP::Daemon; 35 | Digest::MD5 36 | Params::Validate 37 | Proc::Daemon 38 | XML::Simple 39 | 40 | On Fedora, yum installing the following packages should be sufficient 41 | to run the script: 42 | 43 | tar 44 | perl-Config-IniFiles 45 | perl-libwww-perl 46 | perl-MD5 47 | perl-Params-Validate 48 | perl-Proc-Daemon 49 | perl-XML-Simple 50 | 51 | Un Ubuntu, apt-get installing the following packages should do the 52 | trick: 53 | 54 | tar 55 | libconfig-inifiles-perl 56 | libwww-perl 57 | libdigest-md5-perl 58 | libparams-validate-perl 59 | libproc-daemon-perl 60 | libxml-simple-perl 61 | -------------------------------------------------------------------------------- /TROUBLESHOOTING.txt: -------------------------------------------------------------------------------- 1 | Troubleshooting 2 | =============== 3 | 4 | When trying to get this software to work, it is probably a good idea 5 | to: 6 | 7 | * Run it WITHOUT the --daemonize/-d option. This way it stays in the 8 | foregound of your terminal, and can output log and error messages. 9 | 10 | * In the config file, set "LogLevel=trace". That way you will get a 11 | full log of what happens. Also, take note of the "LogFile" 12 | setting, so you know where to find the log. 13 | 14 | * Configure the camera to take small images while testing. This way 15 | you won't have to wait for the data transfers any longer than 16 | necessary. 17 | 18 | In general, if the script encounters errors it will print out "WARN" 19 | messages to the log. These will often start with "Died in request 20 | handling:", followed by the message describing the actual error. 21 | 22 | Some error messages are caused by features in the card and/or the 23 | original Eye-Fi software that this script does not support. In these 24 | cases we will reject the image and log an error, since we can't do 25 | what the card believes we can, and we don't want to fool it. This may 26 | be the problem if you see the following errors: 27 | 28 | Unsupported transfermode 'XXX' from card 'dads eyefi' (000000000000). at ./rifec.pl line 353. 29 | 30 | * If you see this, the card is probably configured to upload images 31 | to online services like Flickr or Facebook. rifec.pl can not do 32 | this. To fix this error, reconfigure your card to upload files 33 | (photos, RAW files, videos) to the local computer only. 34 | 35 | I don't know how to handle tarballs with >1 files! (XXXX, YYYY) at ./rifec.pl line 536. 36 | 37 | * This probably means that the geotagging feature is enabled on the 38 | card. The geotagging feature is a feature of the Eye-Fi software 39 | as well as a feature on the card, so we don't support this either. 40 | Disable geotagging in the card configuration to avoid this error. 41 | 42 | 43 | If the daemon starts, but the images never show up, you can check if 44 | you see something like this in the log: 45 | 46 | ==== 47 | 2011-02-05 01:37:11Z 14024 INFO GetPhotoStatus for 'XXXX.tar' from 'dads eyefi' (000000000000) 48 | 2011-02-05 01:37:12Z 14024 TRACE GetPhotoStatus: $VAR1 = { 49 | [ ... ] 50 | }; 51 | 2011-02-05 01:37:12Z 14024 TRACE GetPhotoStatusResponse: $VAR1 = { 52 | [ ... ] 53 | }; 54 | 2011-02-05 01:47:15Z 14024 DEBUG Closed connection! 55 | ==== 56 | 57 | In this case, the GetPhotoStatus operation is completed successfully. 58 | The next operation should have been an Upload, but instead the 59 | connection is closed ~10 minutes later. This means that the Upload 60 | operation was not completed before the connection timeout occurred. 61 | You may try to increase the SocketTimeout in the config file to 3600 62 | (1 hour), to see if that helps, but you will probably need to do some 63 | kind of network level debugging to see if the card is actually 64 | uploading data, or if it loses the connection for some reason. Useful 65 | tools for this are programs like wireshark (http://www.wireshark.org/) 66 | or iptraf. 67 | -------------------------------------------------------------------------------- /README.txt: -------------------------------------------------------------------------------- 1 | RIFEC: Receive Images From Eye-Fi Cards 2 | ======================================= 3 | 4 | rifec.pl is a standalone program that receives images from Eye-Fi 5 | cards and stores them to disk. 6 | 7 | It works great with my Pro X2 cards running firmware 5.0018 (all the 8 | other 5.x and 4.x versions I have tried worked fine as well). 9 | Feedback from people who have tested other cards and versions is 10 | welcome. 11 | 12 | I have only tested it on Linux, but making it run on other Unix 13 | variants should be trivial. It is written in Perl 5, uses some CPAN 14 | modules, and is GPL. See the file INSTALL.txt for more information on 15 | installation and dependencies. 16 | 17 | It works on Synology NAS devices as well. It installs as an SPK 18 | software package in the DSM Package Center, so it will restart 19 | automatically on reboot etc. Look in the synology/ subdirectory in 20 | the "synology2" branch for more information: 21 | https://github.com/kristofg/rifec/tree/synology2/synology 22 | 23 | This is third-party software; it is not developed nor supported by 24 | Eye-Fi. Because of this, there will be limitations in what it can do 25 | compared to the official Eye-Fi software. 26 | 27 | Please see the file TROUBLESHOOTING.txt if you have problems. 28 | 29 | What can it do? 30 | =============== 31 | 32 | The primary use case is to have the images saved directly to the disk 33 | of a Linux computer on the same WLAN as the camera and card. 34 | 35 | * It supports multiple cards. The destination directory can be 36 | configured per card or as a shared setting. 37 | 38 | * It supports date-based destination directories, based on the clock 39 | on the receiving computer at the time of transfer. 40 | 41 | * It supports different destination directories for different file 42 | types coming from the same card, so you can store jpeg files in one 43 | directory, raw files in another, and videos in a third. 44 | 45 | What can it NOT do? 46 | =================== 47 | 48 | See also the "Todo" and "Ideas" sections further down. The main reason 49 | for not supporting these things are lack of time and need. If someone 50 | has time and need, patches are welcome! 51 | 52 | * The geotagging feature is currently not supported. 53 | 54 | * Running programs (hooks) to manipulate the images after they are 55 | saved is currently not supported. 56 | 57 | * Date-based destination directories based on the image (EXIF) date is 58 | currently not supported (note that date-based destination 59 | directories based on the time of transfer works fine.) 60 | 61 | 62 | Resources and other implementations 63 | =================================== 64 | 65 | The hardware: http://www.eye.fi/ 66 | 67 | This is not the first implementation of such a server. Some of the 68 | others are: 69 | 70 | * https://github.com/tachang/EyeFiServer (Python) 71 | 72 | * https://launchpad.net/eyefi (Python; seems to be the most actively 73 | maintained Python variant) 74 | 75 | * https://github.com/kenkeiter/ryfi (Ruby) 76 | 77 | * https://github.com/hacker/iii (C++) 78 | 79 | * http://randomtechmakings.blogspot.com/2009/01/i-bought-eye-fi-sd-card-few-weeks-ago.html (Perl) 80 | 81 | * http://code.google.com/p/eyefiserver/ (Python - based on 82 | https://github.com/tachang/EyeFiServer) 83 | 84 | The Eye-Fi forum thread at 85 | http://forums.eye.fi/viewtopic.php?f=4&t=270 contains some very useful 86 | information for everyone interested in running or making their own 87 | server. 88 | 89 | 90 | Todo 91 | ==== 92 | 93 | * Tests. It's amazing how fast a small program becomes big enough to 94 | allow bugs to hide in the corners where people rarely go. 95 | 96 | * Limit the number of forked threads, to make it just a little less 97 | DoS'able 98 | 99 | 100 | Things I'm still wondering about 101 | ================================ 102 | 103 | * What is the filesignature field in the SOAP envelope of the file 104 | upload? Something we can check? 105 | 106 | * What does the 'flags' field in the GetPhotoStatus request mean? 107 | 108 | 109 | Ideas 110 | ===== 111 | 112 | * More control over destination directories: 113 | 114 | - Based on file type (jpegs /go/here, raw files /go/there, etc.) 115 | 116 | - Based on EXIF data, so if you have multiple cameras and multiple 117 | cards the images from camera A would end up in the same place 118 | regardless of which card you put in it. (Would be more 119 | interesting if I had multiple Eye-Fi cards.) 120 | 121 | The biggest problem with these features is the configuration part: 122 | How to make this configurable in a robust, easy to understand, and 123 | easy to debug way? 124 | 125 | * Hooks for running custom scripts on successful upload. Would 126 | probably solve the previous problem as well, but has pretty much the 127 | same problems, too. 128 | -------------------------------------------------------------------------------- /rifec.config: -------------------------------------------------------------------------------- 1 | # You can have multiple cards: They need to be in separate sections, 2 | # since you may want to put the images coming from them into different 3 | # directories. Each section must be named "card FOO", where "FOO" can 4 | # be pretty much anything you like. If you want to treat them all the 5 | # same, the Folder and SubFolder settings can be moved to the 'main' 6 | # section instead. 7 | 8 | # After setting the card up on Windows using the Eye-Fi software, find 9 | # the config file called 10 | # C:\Documents and Settings\\Application Data\Eye-Fi\Settings.xml 11 | # and open it. In this file there is a number of elements, and 12 | # in each of those blocks (if you have multiple cards) you will find 13 | # the MacAddress and UploadKey elements which should be copied over to 14 | # the card settings below. 15 | 16 | # For help on the SubFolder format string, see: 17 | # 18 | # http://www.kernel.org/doc/man-pages/online/pages/man3/strftime.3.html 19 | # 20 | # For testing the format string, you can run this on the command line: 21 | # 22 | # $ perl -MPOSIX -e 'print strftime("%Y-%m-%d", localtime()), "\n"' 23 | # 24 | # Where you replace %Y-%m-%d with the format string you want; if the 25 | # result prints out the subdirectory name you want, you're good. 26 | 27 | 28 | [card moms eyefi] 29 | # MAC Address separated by : or - or nothing, found as explained above: 30 | MacAddress=00-00-00-00-00-00 31 | # Upload key for this key, found as explained above: 32 | UploadKey=00000000000000000000000000000000 33 | # Where to put things? 34 | Folder=/data/moms-photos/Eye-Fi 35 | # Want to save images to subfolders per date, under Folder? Enter the 36 | # sub-folder name here as a POSIX::strftime() format string. If you 37 | # don't want to use sub folders, leave the setting blank. 38 | SubFolder=%Yw%V 39 | 40 | 41 | [card dads eyefi] 42 | MacAddress=11-11-11-11-11-11 43 | UploadKey=11111111111111111111111111111111 44 | Folder=/data/dads-photos/Eye-Fi 45 | SubFolder=%Yw%V 46 | # If you have a camera that produces different file types, you can add 47 | # "from CARD filetype BAR" sections, overriding Folder and/or 48 | # SubFolder for filetype BAR from the given card. 49 | # 50 | # The file ending BAR is compared to the file ending of each file, not 51 | # including the dot, case insensitive, and with any whitespace 52 | # stripped. 53 | # 54 | # Using these are optional: Any file types not specified will use the 55 | # card settings, or - if that is empty - the [main] settings. 56 | # 57 | # See also the comments about the top-level FILETYPE section below. 58 | # 59 | [from dads eyefi filetype nef] 60 | SubFolder=%Yw%V/RAW 61 | 62 | # File type specific destinations can be specified on the top level as 63 | # well, by adding sections called "filetype ZOO". The effect of such 64 | # a global setting is the same as specifying the same setting under 65 | # each card which doesn't have one already. 66 | # 67 | # The setting below will send .MOV files from both cards specified to 68 | # the given folder, but a similar setting for "filetype nef" would 69 | # only take effect for Moms card: It would not override Dads setting. 70 | # 71 | # When looking for the Folder and SubFolder settings for a file called 72 | # "foo.jpg" coming from the card "dads card", we will search through 73 | # these sections in this order: 74 | # 75 | # 1. [from dads card filetype jpg] 76 | # 2. [filetype jpg] 77 | # 3. [card dads card] 78 | # 4. [main] 79 | # 80 | # The search is over once we find the key we are looking for; an empty 81 | # value (e.g. "SubFolder=") is a valid match. 82 | # 83 | # Note that this search is done SEPARATELY for Folder and SubFolder, 84 | # so the values we end up using for each of them may come from 85 | # completely different sections. This allows you to do stuff like 86 | # setting the main Folder once, in [main], and then you only need to 87 | # set SubFolders per card and file type. (Example: .NEF files from 88 | # "dads eyefi" in this config will use SubFolder from the "[from dads 89 | # eyefi filetype nef]" section and Folder from the card section.) 90 | # 91 | # Note: Every card must have a Folder setting pointing to a valid, 92 | # writeable directory either in its own card section or in the [main] 93 | # section. This directory must be on the same file system as all the 94 | # final per-filetype destination directories possible for that 95 | # card. This is because the card-level Folder is used for temporary 96 | # storage while receiving and unpacking the filess. 97 | [filetype mov] 98 | Folder=/data/videos 99 | SubFolder= 100 | 101 | 102 | [main] 103 | # Debug level from the script. Valid values: off, warn, info, debug, trace 104 | LogLevel=trace 105 | # Log file: A path name, or blank for STDOUT. (If you want no log at 106 | # all, use LogLevel=off) 107 | LogFile= 108 | # When using subfolders, do you want the date used for making the 109 | # subfolder name to come from the photo timestamp, or from the 110 | # computer clock at the time of transfer? Set to "exif" to use photo 111 | # time, "local" to use computer time. 112 | # NOTE: Currently, only "local" is supported. 113 | SubFolderTimeSource=local 114 | # Network plumbing stuff: These should not need changing 115 | Port=59278 116 | SocketTimeout=600 117 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 2, June 1991 3 | 4 | Copyright (C) 1989, 1991 Free Software Foundation, Inc., 5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | Preamble 10 | 11 | The licenses for most software are designed to take away your 12 | freedom to share and change it. By contrast, the GNU General Public 13 | License is intended to guarantee your freedom to share and change free 14 | software--to make sure the software is free for all its users. This 15 | General Public License applies to most of the Free Software 16 | Foundation's software and to any other program whose authors commit to 17 | using it. (Some other Free Software Foundation software is covered by 18 | the GNU Lesser General Public License instead.) You can apply it to 19 | your programs, too. 20 | 21 | When we speak of free software, we are referring to freedom, not 22 | price. Our General Public Licenses are designed to make sure that you 23 | have the freedom to distribute copies of free software (and charge for 24 | this service if you wish), that you receive source code or can get it 25 | if you want it, that you can change the software or use pieces of it 26 | in new free programs; and that you know you can do these things. 27 | 28 | To protect your rights, we need to make restrictions that forbid 29 | anyone to deny you these rights or to ask you to surrender the rights. 30 | These restrictions translate to certain responsibilities for you if you 31 | distribute copies of the software, or if you modify it. 32 | 33 | For example, if you distribute copies of such a program, whether 34 | gratis or for a fee, you must give the recipients all the rights that 35 | you have. You must make sure that they, too, receive or can get the 36 | source code. And you must show them these terms so they know their 37 | rights. 38 | 39 | We protect your rights with two steps: (1) copyright the software, and 40 | (2) offer you this license which gives you legal permission to copy, 41 | distribute and/or modify the software. 42 | 43 | Also, for each author's protection and ours, we want to make certain 44 | that everyone understands that there is no warranty for this free 45 | software. If the software is modified by someone else and passed on, we 46 | want its recipients to know that what they have is not the original, so 47 | that any problems introduced by others will not reflect on the original 48 | authors' reputations. 49 | 50 | Finally, any free program is threatened constantly by software 51 | patents. We wish to avoid the danger that redistributors of a free 52 | program will individually obtain patent licenses, in effect making the 53 | program proprietary. To prevent this, we have made it clear that any 54 | patent must be licensed for everyone's free use or not licensed at all. 55 | 56 | The precise terms and conditions for copying, distribution and 57 | modification follow. 58 | 59 | GNU GENERAL PUBLIC LICENSE 60 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 61 | 62 | 0. This License applies to any program or other work which contains 63 | a notice placed by the copyright holder saying it may be distributed 64 | under the terms of this General Public License. The "Program", below, 65 | refers to any such program or work, and a "work based on the Program" 66 | means either the Program or any derivative work under copyright law: 67 | that is to say, a work containing the Program or a portion of it, 68 | either verbatim or with modifications and/or translated into another 69 | language. (Hereinafter, translation is included without limitation in 70 | the term "modification".) Each licensee is addressed as "you". 71 | 72 | Activities other than copying, distribution and modification are not 73 | covered by this License; they are outside its scope. The act of 74 | running the Program is not restricted, and the output from the Program 75 | is covered only if its contents constitute a work based on the 76 | Program (independent of having been made by running the Program). 77 | Whether that is true depends on what the Program does. 78 | 79 | 1. You may copy and distribute verbatim copies of the Program's 80 | source code as you receive it, in any medium, provided that you 81 | conspicuously and appropriately publish on each copy an appropriate 82 | copyright notice and disclaimer of warranty; keep intact all the 83 | notices that refer to this License and to the absence of any warranty; 84 | and give any other recipients of the Program a copy of this License 85 | along with the Program. 86 | 87 | You may charge a fee for the physical act of transferring a copy, and 88 | you may at your option offer warranty protection in exchange for a fee. 89 | 90 | 2. You may modify your copy or copies of the Program or any portion 91 | of it, thus forming a work based on the Program, and copy and 92 | distribute such modifications or work under the terms of Section 1 93 | above, provided that you also meet all of these conditions: 94 | 95 | a) You must cause the modified files to carry prominent notices 96 | stating that you changed the files and the date of any change. 97 | 98 | b) You must cause any work that you distribute or publish, that in 99 | whole or in part contains or is derived from the Program or any 100 | part thereof, to be licensed as a whole at no charge to all third 101 | parties under the terms of this License. 102 | 103 | c) If the modified program normally reads commands interactively 104 | when run, you must cause it, when started running for such 105 | interactive use in the most ordinary way, to print or display an 106 | announcement including an appropriate copyright notice and a 107 | notice that there is no warranty (or else, saying that you provide 108 | a warranty) and that users may redistribute the program under 109 | these conditions, and telling the user how to view a copy of this 110 | License. (Exception: if the Program itself is interactive but 111 | does not normally print such an announcement, your work based on 112 | the Program is not required to print an announcement.) 113 | 114 | These requirements apply to the modified work as a whole. If 115 | identifiable sections of that work are not derived from the Program, 116 | and can be reasonably considered independent and separate works in 117 | themselves, then this License, and its terms, do not apply to those 118 | sections when you distribute them as separate works. But when you 119 | distribute the same sections as part of a whole which is a work based 120 | on the Program, the distribution of the whole must be on the terms of 121 | this License, whose permissions for other licensees extend to the 122 | entire whole, and thus to each and every part regardless of who wrote it. 123 | 124 | Thus, it is not the intent of this section to claim rights or contest 125 | your rights to work written entirely by you; rather, the intent is to 126 | exercise the right to control the distribution of derivative or 127 | collective works based on the Program. 128 | 129 | In addition, mere aggregation of another work not based on the Program 130 | with the Program (or with a work based on the Program) on a volume of 131 | a storage or distribution medium does not bring the other work under 132 | the scope of this License. 133 | 134 | 3. You may copy and distribute the Program (or a work based on it, 135 | under Section 2) in object code or executable form under the terms of 136 | Sections 1 and 2 above provided that you also do one of the following: 137 | 138 | a) Accompany it with the complete corresponding machine-readable 139 | source code, which must be distributed under the terms of Sections 140 | 1 and 2 above on a medium customarily used for software interchange; or, 141 | 142 | b) Accompany it with a written offer, valid for at least three 143 | years, to give any third party, for a charge no more than your 144 | cost of physically performing source distribution, a complete 145 | machine-readable copy of the corresponding source code, to be 146 | distributed under the terms of Sections 1 and 2 above on a medium 147 | customarily used for software interchange; or, 148 | 149 | c) Accompany it with the information you received as to the offer 150 | to distribute corresponding source code. (This alternative is 151 | allowed only for noncommercial distribution and only if you 152 | received the program in object code or executable form with such 153 | an offer, in accord with Subsection b above.) 154 | 155 | The source code for a work means the preferred form of the work for 156 | making modifications to it. For an executable work, complete source 157 | code means all the source code for all modules it contains, plus any 158 | associated interface definition files, plus the scripts used to 159 | control compilation and installation of the executable. However, as a 160 | special exception, the source code distributed need not include 161 | anything that is normally distributed (in either source or binary 162 | form) with the major components (compiler, kernel, and so on) of the 163 | operating system on which the executable runs, unless that component 164 | itself accompanies the executable. 165 | 166 | If distribution of executable or object code is made by offering 167 | access to copy from a designated place, then offering equivalent 168 | access to copy the source code from the same place counts as 169 | distribution of the source code, even though third parties are not 170 | compelled to copy the source along with the object code. 171 | 172 | 4. You may not copy, modify, sublicense, or distribute the Program 173 | except as expressly provided under this License. Any attempt 174 | otherwise to copy, modify, sublicense or distribute the Program is 175 | void, and will automatically terminate your rights under this License. 176 | However, parties who have received copies, or rights, from you under 177 | this License will not have their licenses terminated so long as such 178 | parties remain in full compliance. 179 | 180 | 5. You are not required to accept this License, since you have not 181 | signed it. However, nothing else grants you permission to modify or 182 | distribute the Program or its derivative works. These actions are 183 | prohibited by law if you do not accept this License. Therefore, by 184 | modifying or distributing the Program (or any work based on the 185 | Program), you indicate your acceptance of this License to do so, and 186 | all its terms and conditions for copying, distributing or modifying 187 | the Program or works based on it. 188 | 189 | 6. Each time you redistribute the Program (or any work based on the 190 | Program), the recipient automatically receives a license from the 191 | original licensor to copy, distribute or modify the Program subject to 192 | these terms and conditions. You may not impose any further 193 | restrictions on the recipients' exercise of the rights granted herein. 194 | You are not responsible for enforcing compliance by third parties to 195 | this License. 196 | 197 | 7. If, as a consequence of a court judgment or allegation of patent 198 | infringement or for any other reason (not limited to patent issues), 199 | conditions are imposed on you (whether by court order, agreement or 200 | otherwise) that contradict the conditions of this License, they do not 201 | excuse you from the conditions of this License. If you cannot 202 | distribute so as to satisfy simultaneously your obligations under this 203 | License and any other pertinent obligations, then as a consequence you 204 | may not distribute the Program at all. For example, if a patent 205 | license would not permit royalty-free redistribution of the Program by 206 | all those who receive copies directly or indirectly through you, then 207 | the only way you could satisfy both it and this License would be to 208 | refrain entirely from distribution of the Program. 209 | 210 | If any portion of this section is held invalid or unenforceable under 211 | any particular circumstance, the balance of the section is intended to 212 | apply and the section as a whole is intended to apply in other 213 | circumstances. 214 | 215 | It is not the purpose of this section to induce you to infringe any 216 | patents or other property right claims or to contest validity of any 217 | such claims; this section has the sole purpose of protecting the 218 | integrity of the free software distribution system, which is 219 | implemented by public license practices. Many people have made 220 | generous contributions to the wide range of software distributed 221 | through that system in reliance on consistent application of that 222 | system; it is up to the author/donor to decide if he or she is willing 223 | to distribute software through any other system and a licensee cannot 224 | impose that choice. 225 | 226 | This section is intended to make thoroughly clear what is believed to 227 | be a consequence of the rest of this License. 228 | 229 | 8. If the distribution and/or use of the Program is restricted in 230 | certain countries either by patents or by copyrighted interfaces, the 231 | original copyright holder who places the Program under this License 232 | may add an explicit geographical distribution limitation excluding 233 | those countries, so that distribution is permitted only in or among 234 | countries not thus excluded. In such case, this License incorporates 235 | the limitation as if written in the body of this License. 236 | 237 | 9. The Free Software Foundation may publish revised and/or new versions 238 | of the General Public License from time to time. Such new versions will 239 | be similar in spirit to the present version, but may differ in detail to 240 | address new problems or concerns. 241 | 242 | Each version is given a distinguishing version number. If the Program 243 | specifies a version number of this License which applies to it and "any 244 | later version", you have the option of following the terms and conditions 245 | either of that version or of any later version published by the Free 246 | Software Foundation. If the Program does not specify a version number of 247 | this License, you may choose any version ever published by the Free Software 248 | Foundation. 249 | 250 | 10. If you wish to incorporate parts of the Program into other free 251 | programs whose distribution conditions are different, write to the author 252 | to ask for permission. For software which is copyrighted by the Free 253 | Software Foundation, write to the Free Software Foundation; we sometimes 254 | make exceptions for this. Our decision will be guided by the two goals 255 | of preserving the free status of all derivatives of our free software and 256 | of promoting the sharing and reuse of software generally. 257 | 258 | NO WARRANTY 259 | 260 | 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 261 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 262 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 263 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED 264 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 265 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS 266 | TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 267 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, 268 | REPAIR OR CORRECTION. 269 | 270 | 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 271 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 272 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 273 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING 274 | OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED 275 | TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY 276 | YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER 277 | PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 278 | POSSIBILITY OF SUCH DAMAGES. 279 | 280 | END OF TERMS AND CONDITIONS 281 | 282 | How to Apply These Terms to Your New Programs 283 | 284 | If you develop a new program, and you want it to be of the greatest 285 | possible use to the public, the best way to achieve this is to make it 286 | free software which everyone can redistribute and change under these terms. 287 | 288 | To do so, attach the following notices to the program. It is safest 289 | to attach them to the start of each source file to most effectively 290 | convey the exclusion of warranty; and each file should have at least 291 | the "copyright" line and a pointer to where the full notice is found. 292 | 293 | 294 | Copyright (C) 295 | 296 | This program is free software; you can redistribute it and/or modify 297 | it under the terms of the GNU General Public License as published by 298 | the Free Software Foundation; either version 2 of the License, or 299 | (at your option) any later version. 300 | 301 | This program is distributed in the hope that it will be useful, 302 | but WITHOUT ANY WARRANTY; without even the implied warranty of 303 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 304 | GNU General Public License for more details. 305 | 306 | You should have received a copy of the GNU General Public License along 307 | with this program; if not, write to the Free Software Foundation, Inc., 308 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 309 | 310 | Also add information on how to contact you by electronic and paper mail. 311 | 312 | If the program is interactive, make it output a short notice like this 313 | when it starts in an interactive mode: 314 | 315 | Gnomovision version 69, Copyright (C) year name of author 316 | Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 317 | This is free software, and you are welcome to redistribute it 318 | under certain conditions; type `show c' for details. 319 | 320 | The hypothetical commands `show w' and `show c' should show the appropriate 321 | parts of the General Public License. Of course, the commands you use may 322 | be called something other than `show w' and `show c'; they could even be 323 | mouse-clicks or menu items--whatever suits your program. 324 | 325 | You should also get your employer (if you work as a programmer) or your 326 | school, if any, to sign a "copyright disclaimer" for the program, if 327 | necessary. Here is a sample; alter the names: 328 | 329 | Yoyodyne, Inc., hereby disclaims all copyright interest in the program 330 | `Gnomovision' (which makes passes at compilers) written by James Hacker. 331 | 332 | , 1 April 1989 333 | Ty Coon, President of Vice 334 | 335 | This General Public License does not permit incorporating your program into 336 | proprietary programs. If your program is a subroutine library, you may 337 | consider it more useful to permit linking proprietary applications with the 338 | library. If this is what you want to do, use the GNU Lesser General 339 | Public License instead of this License. 340 | -------------------------------------------------------------------------------- /rifec.pl: -------------------------------------------------------------------------------- 1 | #! /usr/bin/perl 2 | # 3 | # RIFEC.pl: Receive Images From Eye-Fi Cards 4 | # Copyright (C) 2011 Kristoffer Gleditsch, https://github.com/kristofg 5 | # 6 | # This program is free software; you can redistribute it and/or modify 7 | # it under the terms of the GNU General Public License as published by 8 | # the Free Software Foundation; either version 2 of the License, or 9 | # (at your option) any later version. 10 | # 11 | # This program is distributed in the hope that it will be useful, 12 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | # GNU General Public License for more details. 15 | # 16 | # You should have received a copy of the GNU General Public License 17 | # along with this program; if not, write to the Free Software 18 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 19 | # 02110-1301, USA. 20 | # 21 | 22 | # There are two global objects, ::Config and ::Log, each accessed 23 | # through a global variable. At the bottom of the script, there is a 24 | # plain sub implementing the listen/fork loop on the socket. For each 25 | # incoming connection, it instantiates a ::Handler object. All 26 | # incoming requests on the same connection is sent there. The 27 | # ::Session and ::File objects are helper objects used internally by 28 | # the ::Handler. 29 | 30 | require 5.014; 31 | 32 | use strict; 33 | use warnings; 34 | use filetest 'access'; 35 | 36 | my $log; 37 | my $config; 38 | 39 | # Config parsing and handling (accessed through the $config object) 40 | package RIFEC::Config { 41 | use Carp qw(confess); 42 | use Config::IniFiles; 43 | use Cwd qw(); 44 | use Data::Dumper; 45 | use Params::Validate; 46 | use POSIX qw(); 47 | 48 | our $card_section_re = qr/\A card \s+ (.*?)\z/xi; 49 | our $filetype_section_re = qr/\A filetype \s+ (.*?)\z/xi; 50 | our $from_section_re = qr/\A from \s+ (.*?) \s+ filetype \s+ (.*?)\z/xi; 51 | 52 | sub new { 53 | validate_pos(@_, 1, 0); 54 | my ($class, $file) = @_; 55 | 56 | my $self = {}; 57 | bless($self, $class); 58 | 59 | $self->{'_file'} = $file if @_ > 1; 60 | $self->{'_cfg'} = $self->_build_config(); 61 | $self->{'_counter'} = 0; 62 | 63 | return $self; 64 | } 65 | 66 | sub _file { 67 | validate_pos(@_, 1); 68 | my ($self) = @_; 69 | return $self->{'_file'}; 70 | } 71 | 72 | sub _cfg { 73 | validate_pos(@_, 1); 74 | my ($self) = @_; 75 | return $self->{'_cfg'}; 76 | } 77 | 78 | sub counter { 79 | validate_pos(@_, 1); 80 | my ($self) = @_; 81 | return $self->{'_counter'}; 82 | } 83 | 84 | sub bump_counter { 85 | validate_pos(@_, 1); 86 | my ($self) = @_; 87 | return ++$self->{'_counter'}; 88 | } 89 | 90 | sub normalize_mac { 91 | validate_pos(@_, 1, 1); 92 | my ($self, $in) = @_; 93 | 94 | my $ret = lc $in; 95 | $ret =~ s/[-: ]//gx; 96 | confess "'$in' doesn't look like a MAC address" 97 | unless $ret =~ m|\A [a-z0-9]{12} \z|xi; 98 | 99 | return $ret; 100 | } 101 | 102 | sub _read_inifile { 103 | validate_pos(@_, 1); 104 | my ($self) = @_; 105 | 106 | # Fall back to default if undef or empty: 107 | $self->{'file'} = "rifec.config" unless $self->_file; 108 | 109 | # Absolute-ize, so that error messages output a full path: 110 | $self->{'file'} = Cwd::abs_path($self->_file); 111 | 112 | confess sprintf("Config file '%s' does not exist", $self->_file) 113 | unless -e $self->_file; 114 | confess sprintf("Config file '%s' is not readable", $self->_file) 115 | unless -r $self->_file; 116 | confess sprintf("Config file '%s' is empty", $self->_file) 117 | unless -s $self->_file; 118 | 119 | my %cfg; 120 | tie(%cfg, 'Config::IniFiles', (-file => $self->_file, 121 | -nocase => 1, 122 | -allowempty => 0)); 123 | confess "Unable to read config file: ", Dumper(@Config::IniFiles::errors) 124 | unless %cfg; 125 | return \%cfg; 126 | } 127 | 128 | sub _validate_inifile { 129 | validate_pos(@_, 1, { type => Params::Validate::HASHREF }); 130 | my ($self, $ini) = @_; 131 | 132 | my %paramspec_of = ( 133 | $card_section_re => { 134 | 'macaddress' => 1, 135 | 'uploadkey' => 1, 136 | 'folder' => 0, 137 | 'subfolder' => 0, 138 | }, 139 | $from_section_re => { 140 | 'folder' => 0, 141 | 'subfolder' => 0, 142 | }, 143 | $filetype_section_re => { 144 | 'folder' => 0, 145 | 'subfolder' => 0, 146 | }, 147 | qr/\A main \z/xi => { 148 | 'logfile' => 1, 149 | 'loglevel' => 1, 150 | 'port' => 1, 151 | 'sockettimeout' => 1, 152 | 'subfoldertimesource' => 0, 153 | 'tarcommand' => 0, 154 | 'folder' => 0, 155 | 'subfolder' => 0, 156 | }, 157 | ); 158 | 159 | foreach my $key (keys %$ini) { 160 | # Find the paramspec for this type of section: 161 | my @match = grep { $key =~ $_ } keys %paramspec_of; 162 | # Every section should match one and only one paramspec: 163 | if (scalar(@match) != 1) { 164 | confess sprintf("Unrecognized or malformed config section name '%s'", 165 | $key); 166 | } 167 | 168 | my @inifields = %{$ini->{$key}}; 169 | validate(@inifields, $paramspec_of{$match[0]}); 170 | } 171 | } 172 | 173 | sub _build_config { 174 | validate_pos(@_, 1); 175 | my ($self) = @_; 176 | 177 | my $filecfg = $self->_read_inifile(); 178 | $self->_validate_inifile($filecfg); 179 | my $c = {}; 180 | 181 | # Main section: 182 | foreach my $s (keys %{ $filecfg->{'main'} }) { 183 | $c->{'main'}->{$s} = $filecfg->{'main'}->{$s}; 184 | } 185 | 186 | # top-level filetype sections: 187 | foreach my $ft_section (grep { $_ =~ $filetype_section_re } keys %$filecfg) { 188 | $ft_section =~ $filetype_section_re 189 | || confess "Unexpected regexp mismatch"; 190 | my $type = $1; 191 | foreach my $f (keys %{ $filecfg->{$ft_section} }) { 192 | $c->{'filetypes'}->{$type}->{$f} = $filecfg->{$ft_section}->{$f}; 193 | } 194 | } 195 | 196 | # card sections: 197 | foreach my $card_section (grep { $_ =~ $card_section_re } keys %$filecfg) { 198 | $card_section =~ $card_section_re 199 | || confess "Unexpected regexp mismatch"; 200 | my $cardname = $1; 201 | foreach my $s (keys %{ $filecfg->{$card_section}}) { 202 | my $value = $filecfg->{$card_section}->{$s}; 203 | if ($s eq 'macaddress') { 204 | $value = $self->normalize_mac($value); 205 | } 206 | $c->{'cards'}->{$cardname}->{$s} = $value; 207 | } 208 | # We are messing around with card names here, but the 209 | # actual config lookups will be by MAC: 210 | my $mac = $c->{'cards'}->{$cardname}->{'macaddress'}; 211 | $c->{'macs'}->{$mac} = $c->{'cards'}->{$cardname}; 212 | # Add the name to the hash, so the people who've only got 213 | # the MAC can get at it: 214 | $c->{'cards'}->{$cardname}->{'name'} = $cardname; 215 | } 216 | 217 | # from X filetype Y sections: 218 | foreach my $from_section (grep { $_ =~ $from_section_re } keys %$filecfg) { 219 | $from_section =~ $from_section_re 220 | || confess "Unexptected regexp mismatch"; 221 | my $card = $1; 222 | my $type = $2; 223 | 224 | confess sprintf("section '%s' doesn't match any card names!", 225 | $from_section) 226 | unless exists $c->{'cards'}->{$card}; 227 | 228 | foreach my $s (keys %{ $filecfg->{$from_section} }) { 229 | $c->{'cards'}->{$card}->{'filetypes'}->{$type}->{$s} = 230 | $filecfg->{$from_section}->{$s}; 231 | } 232 | } 233 | 234 | #print STDERR "Config hash dump: ", Dumper($c), "\n"; 235 | return $c; 236 | } 237 | 238 | sub say_hello { 239 | validate_pos(@_, 1); 240 | my ($self) = @_; 241 | 242 | $log->info("Config file '%s', %d card(s) configured:", 243 | Cwd::abs_path($self->_file), 244 | scalar keys %{ $self->_cfg->{'cards'} }); 245 | 246 | foreach my $card (keys %{ $self->_cfg->{'cards'} }) { 247 | $log->info(" Card '%s' (%s)", 248 | $card, 249 | $self->_cfg->{'cards'}->{$card}->{'macaddress'}); 250 | } 251 | } 252 | 253 | sub doiknow { 254 | validate_pos(@_, 1, 1); 255 | my ($self, $mac) = @_; 256 | 257 | $mac = $self->normalize_mac($mac); 258 | 259 | confess sprintf("Sorry, I don't know the card with MAC '%s'", $mac) 260 | unless exists $self->_cfg->{'macs'}->{$mac}; 261 | 262 | return 1; 263 | } 264 | 265 | sub check_writeable_dir { 266 | validate_pos(@_, 1, 1); 267 | my ($self, $dir) = @_; 268 | 269 | confess sprintf("Destination directory '%s' not found", $dir) 270 | unless -e $dir; 271 | confess sprintf("Destination directory '%s' not a directory", $dir) 272 | unless -d $dir; 273 | confess sprintf("Destination directory '%s' not writeable", $dir) 274 | unless -w $dir; 275 | } 276 | 277 | # Actual config accessors. 278 | sub logfile { 279 | validate_pos(@_, 1); 280 | my ($self) = @_; 281 | return $self->_cfg->{'main'}->{'logfile'}; 282 | } 283 | 284 | sub loglevel { 285 | validate_pos(@_, 1); 286 | my ($self) = @_; 287 | return $self->_cfg->{'main'}->{'loglevel'}; 288 | } 289 | 290 | sub port { 291 | validate_pos(@_, 1); 292 | my ($self) = @_; 293 | return $self->_cfg->{'main'}->{'port'} || 59278; 294 | } 295 | 296 | sub sockettimeout { 297 | validate_pos(@_, 1); 298 | my ($self) = @_; 299 | return $self->_cfg->{'main'}->{'sockettimeout'} || 600; 300 | } 301 | 302 | sub tarcommand { 303 | validate_pos(@_, 1); 304 | my ($self) = @_; 305 | 306 | my $tc = $self->_cfg->{'main'}->{'tarcommand'} || "/bin/tar"; 307 | 308 | # Verify that the tar command looks sane: 309 | my $help = "Please tell me where tar is by adding 'TarCommand=/path/to/tar' to the main section of your config file"; 310 | confess "'$tc' not found: $help" 311 | unless -e $tc; 312 | confess "'$tc' is not executable: $help" 313 | unless -x $tc; 314 | 315 | return $tc; 316 | } 317 | 318 | sub subfoldertimesource { 319 | validate_pos(@_, 1); 320 | my ($self) = @_; 321 | return $self->_cfg->{'main'}->{'subfoldertimesource'} || "local"; 322 | } 323 | 324 | # Per-card settings: 325 | sub _mac_setting { 326 | validate_pos(@_, 1, 1, 1); 327 | my ($self, $mac, $setting) = @_; 328 | 329 | $self->doiknow($mac); 330 | $mac = $self->normalize_mac($mac); 331 | 332 | confess sprintf("Error looking up setting '%s' for card '%s'", 333 | $setting, $mac) 334 | unless exists $self->_cfg->{'macs'}->{$mac}->{$setting}; 335 | 336 | return $self->_cfg->{'macs'}->{$mac}->{$setting}; 337 | } 338 | 339 | sub cardname { 340 | validate_pos(@_, 1, 1); 341 | my ($self, $mac) = @_; 342 | return $self->_mac_setting($mac, 'name'); 343 | } 344 | 345 | sub uploadkey { 346 | validate_pos(@_, 1, 1); 347 | my ($self, $mac) = @_; 348 | return $self->_mac_setting($mac, 'uploadkey'); 349 | } 350 | 351 | sub _foldersetting { 352 | validate_pos(@_, 1, 1, 1, 1); 353 | my ($self, $setting, $mac, $filename) = @_; 354 | 355 | $self->doiknow($mac); 356 | $mac = $self->normalize_mac($mac); 357 | 358 | my $cfg = $self->_cfg; 359 | 360 | if (defined($filename) && $filename) { 361 | $filename =~ / \. ([^ \.]*?) \z/xi 362 | || confess "Unable to extract file type from name '$filename'"; 363 | my $type = lc $1; 364 | 365 | if (exists $cfg->{'macs'}->{$mac}->{'filetypes'}->{$type} && 366 | exists $cfg->{'macs'}->{$mac}->{'filetypes'}->{$type}->{$setting}) 367 | { 368 | return $cfg->{'macs'}->{$mac}->{'filetypes'}->{$type}->{$setting}; 369 | } 370 | 371 | if (exists $cfg->{'filetypes'}->{$type} && 372 | exists $cfg->{'filetypes'}->{$type}->{$setting}) 373 | { 374 | return $cfg->{'filetypes'}->{$type}->{$setting}; 375 | } 376 | } 377 | 378 | if (exists $cfg->{'macs'}->{$mac}->{$setting}) { 379 | return $cfg->{'macs'}->{$mac}->{$setting}; 380 | } 381 | 382 | if (exists $cfg->{'main'}->{$setting}) { 383 | return $cfg->{'main'}->{$setting} 384 | } 385 | 386 | return; 387 | } 388 | 389 | sub folder { 390 | validate_pos(@_, 1, 1, 0); 391 | my ($self, $mac, $filename) = @_; 392 | 393 | my $f = $self->_foldersetting('folder', $mac, $filename || ''); 394 | 395 | confess sprintf("Error looking up folder for card '%s' file '%s'", 396 | $self->_cfg->{'macs'}->{$mac}->{'name'}, 397 | $filename || '') 398 | unless defined($f) && $f; 399 | 400 | $self->check_writeable_dir($f); 401 | return $f; 402 | } 403 | 404 | sub subfolder { 405 | validate_pos(@_, 1, 1, 0); 406 | my ($self, $mac, $filename) = @_; 407 | return $self->_foldersetting('subfolder', $mac, $filename || ''); 408 | } 409 | 410 | 1; 411 | } 412 | 413 | # Logging, accessed through the $log object: 414 | package RIFEC::Log { 415 | use Carp qw(confess); 416 | use Data::Dumper; 417 | use HTTP::Date qw(); 418 | use IO::File; 419 | use Params::Validate; 420 | 421 | sub new { 422 | validate_pos(@_, 1, 0); 423 | my ($class, $file) = @_; 424 | 425 | my $self = {}; 426 | bless($self, $class); 427 | 428 | $self->{'_fh'} = \*STDOUT; 429 | $self->open(); 430 | 431 | return $self; 432 | } 433 | 434 | sub _fh { 435 | validate_pos(@_, 1); 436 | my ($self) = @_; 437 | return $self->{'_fh'}; 438 | } 439 | 440 | sub DESTROY { 441 | my ($self) = @_; 442 | 443 | if (defined $self->_fh) { 444 | $self->_fh->close() 445 | or confess "Unable to close log filehandle while exiting: $!"; 446 | } 447 | } 448 | 449 | sub loglevel { 450 | return { 451 | 'off' => 100, 452 | 'warning' => 4, 453 | 'info' => 3, 454 | 'debug' => 2, 455 | 'trace' => 1, 456 | }; 457 | }; 458 | 459 | sub open { 460 | validate_pos(@_, 1); 461 | my ($self) = @_; 462 | 463 | if (my $lf = $config->logfile()) { 464 | $self->_fh->close() 465 | or confess "Unable to close logfile while exiting: $!"; 466 | 467 | my $fh = IO::File->new($lf, O_WRONLY|O_APPEND|O_CREAT) 468 | or confess "Unable to open logfile '$lf' for writing: $!"; 469 | $self->{'_fh'} = $fh; 470 | } 471 | } 472 | 473 | sub _get_preamble { 474 | validate_pos(@_, 1, 1); 475 | my ($self, $ll) = @_; 476 | 477 | return sprintf("%s %7u %7s ", 478 | HTTP::Date::time2isoz(), 479 | $$, 480 | uc $ll); 481 | } 482 | 483 | sub _print_if { 484 | validate_pos(@_, 1, 1, (0) x (@_ - 2)); 485 | my ($self, $loglevel, @str) = @_; 486 | 487 | # Sanity check. 488 | foreach my $ll ($loglevel, $config->loglevel) { 489 | confess sprintf("Invalid loglevel '%s'", $ll) 490 | unless $self->loglevel->{lc $ll}; 491 | } 492 | 493 | if ($self->loglevel->{lc $loglevel} >= $self->loglevel->{lc $config->loglevel}) 494 | { 495 | my $out = $self->_get_preamble($loglevel); 496 | 497 | # figure out if it's a (s)printf or not: 498 | if (scalar(@str) == 1) { 499 | $out .= $str[0]; 500 | } 501 | elsif (scalar(@str) > 1) { 502 | $out .= sprintf shift(@str), @str; 503 | } 504 | else { 505 | confess "If you log, please send content too."; 506 | } 507 | # \n-terminate if needed 508 | $out .= ($out =~ / \n \z/x) ? "" : "\n"; 509 | 510 | print { $self->_fh } $out; 511 | $self->_fh->flush(); 512 | } 513 | } 514 | 515 | sub trace { 516 | my ($self, @str) = @_; 517 | $self->_print_if('trace', @str); 518 | } 519 | 520 | sub debug { 521 | my ($self, @str) = @_; 522 | $self->_print_if('debug', @str); 523 | } 524 | 525 | sub info { 526 | my ($self, @str) = @_; 527 | $self->_print_if('info', @str); 528 | } 529 | 530 | sub warning { 531 | my ($self, @str) = @_; 532 | $self->_print_if('warning', @str); 533 | } 534 | 535 | 1; 536 | } 537 | 538 | package RIFEC::Session { 539 | use Carp qw(confess); 540 | use Data::Dumper; 541 | use Digest::MD5 qw(md5_hex); 542 | use IO::File; 543 | use Params::Validate; 544 | 545 | sub new { 546 | my $class = shift; 547 | my %p = validate(@_, { 'card' => 1, 548 | 'transfermode' => 1, 549 | 'transfermodetimestamp' => 1, 550 | 'card_nonce' => 1, }); 551 | 552 | my $self = {}; 553 | bless($self, $class); 554 | 555 | foreach my $key (keys %p) { 556 | $self->{$key} = $p{$key}; 557 | } 558 | $self->{'server_nonce'} = $self->_generate_s_nonce(); 559 | $self->{'is_authenticated'} = undef; 560 | 561 | $self->_check_params(); 562 | 563 | return $self; 564 | } 565 | 566 | sub card { 567 | validate_pos(@_, 1); 568 | my ($self) = @_; 569 | return $self->{'card'}; 570 | } 571 | 572 | sub transfermode { 573 | validate_pos(@_, 1); 574 | my ($self) = @_; 575 | return $self->{'transfermode'}; 576 | } 577 | 578 | sub transfermodetimestamp { 579 | validate_pos(@_, 1); 580 | my ($self) = @_; 581 | return $self->{'transfermodetimestamp'}; 582 | } 583 | 584 | sub card_nonce { 585 | validate_pos(@_, 1); 586 | my ($self) = @_; 587 | return $self->{'card_nonce'}; 588 | } 589 | 590 | sub server_nonce { 591 | validate_pos(@_, 1); 592 | my ($self) = @_; 593 | return $self->{'server_nonce'}; 594 | } 595 | 596 | sub authenticated { 597 | validate_pos(@_, 1, 0); 598 | my ($self, $set) = @_; 599 | 600 | $self->{'is_authenticated'} = $set if @_ > 1; 601 | return $self->{'is_authenticated'}; 602 | } 603 | 604 | # We used to use the Crypt::Random library for this, but it is not 605 | # available through the package manager of all Linux 606 | # distributions, and was just a wrapper around reading the data 607 | # from /dev/urandom anyway. 608 | sub getrandom { 609 | validate_pos(@_, 1, 1); 610 | my ($self, $bytes) = @_; 611 | 612 | my $random_file = "/dev/urandom"; 613 | my $output; 614 | my $has_read = 0; 615 | 616 | my $fh = IO::File->new($random_file, O_RDONLY) 617 | or confess "Unable to open '$random_file' for reading random data: $!"; 618 | 619 | while ($has_read < $bytes) { 620 | my $o; 621 | my $read_status = $fh->read($o, $bytes - $has_read); 622 | 623 | if (!defined $read_status) { 624 | confess "Error while reading random data from '$random_file': $!"; 625 | } 626 | elsif ($read_status == 0) { 627 | confess "Reached EOF while reading random data from '$random_file'"; 628 | } 629 | $output .= $o; 630 | $has_read += $read_status; 631 | } 632 | 633 | $fh->close() 634 | or confess "Unable to close '$random_file': $!"; 635 | return $output; 636 | } 637 | 638 | sub _generate_s_nonce { 639 | my ($self) = @_; 640 | my $octets = $self->getrandom(16); 641 | return unpack("H*", $octets); 642 | } 643 | 644 | sub _check_params { 645 | my ($self) = @_; 646 | 647 | # Only accept cards that have a config section 648 | $config->doiknow($self->card); 649 | 650 | # Only accept transfer modes that we recognize. My card sends 651 | # 546 (0x222), and from basic testing twiddling switches in 652 | # the config GUI, it looks like this number is a bitmask: 653 | # 654 | # 0 1 0 0 0 1 0 0 0 1 0 = 546 655 | # 1 = 2 : Transfer photos to computer 656 | # 1 = 32 : Transfer videos to computer 657 | # 1 = 512 : Transfer RAW files to computer 658 | # 659 | # I'll go with that theory for now: Either way this approach 660 | # means all the modes I have seen will work, and the ones I 661 | # haven't won't. 662 | my $known_txmodes = 1<<1 | 1<<5 | 1<<9; 663 | 664 | if ($self->transfermode & ~$known_txmodes) { 665 | confess sprintf("Unsupported transfermode '%s' from card '%s' (%s)," . 666 | " See TROUBLESHOOTING.txt for info about what this means", 667 | $self->transfermode, 668 | $config->cardname($self->card), 669 | $self->card); 670 | } 671 | } 672 | 673 | sub server_credential { 674 | my ($self) = @_; 675 | return md5_hex(pack("H*", $self->card), 676 | pack("H*", $self->card_nonce), 677 | pack("H*", $config->uploadkey($self->card))); 678 | } 679 | 680 | sub card_credential { 681 | my ($self) = @_; 682 | return md5_hex(pack("H*", $self->card), 683 | pack("H*", $config->uploadkey($self->card)), 684 | pack("H*", $self->server_nonce)); 685 | } 686 | } 687 | 688 | package RIFEC::File { 689 | use Carp qw(confess); 690 | use Data::Dumper; 691 | use Digest::MD5 qw(); 692 | use File::Spec; 693 | use File::Temp qw(); 694 | use IO::File; 695 | use Params::Validate; 696 | use POSIX qw(); 697 | 698 | # If your camera produces files containing other characters than I 699 | # have thought of here, you may have to change this regexp. (All 700 | # places checking the file name should use this, so it should be 701 | # sufficient to update this one place). 702 | our $filename_regexp = qr|\A [ a-z0-9._-]* \z|xi; 703 | 704 | sub new { 705 | my $class = shift; 706 | my %p = validate(@_, { 'session' => { isa => 'RIFEC::Session' }, 707 | 'tarfilename' => 1, 708 | 'size' => 1, 709 | 'encryption' => 0, 710 | 'filesignature' => 1, }); 711 | 712 | my $self = {}; 713 | bless($self, $class); 714 | 715 | foreach my $key (keys %p) { 716 | $self->{$key} = $p{$key}; 717 | } 718 | return $self; 719 | } 720 | 721 | # RO parameters: 722 | sub session { 723 | validate_pos(@_, 1); 724 | my ($self) = @_; 725 | return $self->{'session'}; 726 | } 727 | 728 | sub tarfilename { 729 | validate_pos(@_, 1); 730 | my ($self) = @_; 731 | return $self->{'tarfilename'}; 732 | } 733 | 734 | sub size { 735 | validate_pos(@_, 1); 736 | my ($self) = @_; 737 | return $self->{'size'}; 738 | } 739 | 740 | sub encryption { 741 | validate_pos(@_, 1); 742 | my ($self) = @_; 743 | return $self->{'encryption'}; 744 | } 745 | 746 | sub filesignature { 747 | validate_pos(@_, 1); 748 | my ($self) = @_; 749 | return $self->{'filesignature'}; 750 | } 751 | 752 | # RW parameters: 753 | sub integritydigest { 754 | validate_pos(@_, 1, 0); 755 | my ($self, $set) = @_; 756 | 757 | $self->{'integritydigest'} = $set if @_ > 1; 758 | return $self->{'integritydigest'}; 759 | } 760 | 761 | sub calculated_digest { 762 | validate_pos(@_, 1, 0); 763 | my ($self, $set) = @_; 764 | 765 | $self->{'calculated_digest'} = $set if @_ > 1; 766 | return $self->{'calculated_digest'}; 767 | } 768 | 769 | sub tarfile { 770 | validate_pos(@_, 1, 0); 771 | my ($self, $set) = @_; 772 | 773 | $self->{'tarfile'} = $set if @_ > 1; 774 | return $self->{'tarfile'}; 775 | } 776 | 777 | sub stored_file { 778 | validate_pos(@_, 1, 0); 779 | my ($self, $set) = @_; 780 | 781 | $self->{'stored_file'} = $set if @_ > 1; 782 | return $self->{'stored_file'}; 783 | } 784 | 785 | # See http://forums.eye.fi/viewtopic.php?f=4&t=270#p3874 786 | sub _calculate_tcp_checksum { 787 | my ($self, $block) = @_; 788 | my $val = 0; 789 | 790 | map { $val += $_ } unpack "S*", $block; 791 | 792 | while (my $rest = $val >> 16) { 793 | $val = ($val & 0xFFFF) + $rest; 794 | } 795 | return pack("S", ~$val); 796 | } 797 | 798 | # Calculating this while receiving the file, ie. in 799 | # Handler::read_socket, would be much faster. However, by doing 800 | # it afterwards we get a sanity check that read_part/read_socket 801 | # didn't mess up our data in transit. Belt and braces. 802 | sub _calculate_integritydigest { 803 | my ($self) = @_; 804 | 805 | my $file = $self->tarfile; 806 | $log->debug("Calculating integrity digest of '%s'", $file); 807 | 808 | my $blocksize = 512; 809 | 810 | # Make sure it is 512-block aligned (it should be) 811 | my $length = (stat($file))[7]; 812 | confess "Tar file not 512-byte aligned!" 813 | if $length % $blocksize; 814 | 815 | my $md5 = Digest::MD5->new(); 816 | my $fh = IO::File->new($file, O_RDONLY) 817 | or confess "Unable to open '$file': $!"; 818 | 819 | my $i = 0; 820 | while ($i < $length) { 821 | my $block; 822 | my $read_status = $fh->read($block, $blocksize); 823 | 824 | confess "Error while reading from '$file': $!" 825 | unless defined $read_status; 826 | 827 | confess "Reached EOF while reading from '$file'" 828 | if $read_status == 0; 829 | 830 | confess "Unexpected read length [$read_status] from '$file'" 831 | unless $read_status == $blocksize; 832 | 833 | $md5->add( $self->_calculate_tcp_checksum($block) ); 834 | $i += $blocksize; 835 | } 836 | 837 | $fh->close() 838 | or confess "Unable to close '$file': $!"; 839 | 840 | $md5->add(pack("H*", $config->uploadkey($self->session->card))); 841 | my $md5sum = $md5->hexdigest(); 842 | 843 | $log->debug("...done: %s", uc $md5sum); 844 | $self->calculated_digest(uc $md5sum); 845 | return uc $md5sum; 846 | } 847 | 848 | sub receiver_filehandle { 849 | validate_pos(@_, 1, 1); 850 | my ($self, $inner_filename) = @_; 851 | 852 | my $folder = $config->folder($self->session->card); 853 | $config->check_writeable_dir($folder); 854 | 855 | my $tfh = File::Temp->new( 856 | TEMPLATE => sprintf(".rifec-receiving-%d--%s--XXXXXXXX", 857 | $$, 858 | $inner_filename), 859 | DIR => $folder, 860 | UNLINK => 0); 861 | my $tfn = $tfh->filename; 862 | 863 | $self->tarfile($tfn); # Remember where we put it 864 | $log->debug("Receiver file: '%s' ('%s')", $tfn, $self->tarfilename); 865 | return $tfh; 866 | } 867 | 868 | sub check { 869 | validate_pos(@_, 1); 870 | my ($self) = @_; 871 | 872 | # First that the size matches what the card said: 873 | my $stat_size = (stat($self->tarfile))[7]; 874 | if ($stat_size == $self->size) 875 | { 876 | $log->debug("File '%s' is %d bytes long, as expected", 877 | $self->tarfile, 878 | $self->size); 879 | } 880 | else { 881 | $log->warning("File '%s' is %d bytes long, should have been %d", 882 | $self->tarfile, 883 | $stat_size, 884 | $self->size); 885 | return; 886 | } 887 | 888 | # Then check the integrity digest field: 889 | $self->_calculate_integritydigest(); 890 | 891 | if (uc($self->calculated_digest()) eq uc($self->integritydigest())) 892 | { 893 | $log->debug("Integritydigest OK: [%s]", uc $self->integritydigest()); 894 | } 895 | else { 896 | $log->warning("Integritydigests does not match!"); 897 | $log->warning(" Calculated: [%s]\n Received: [%s]", 898 | uc $self->calculated_digest(), 899 | uc $self->integritydigest()); 900 | return; 901 | } 902 | return 1; 903 | } 904 | 905 | sub _subfolder { 906 | validate_pos(@_, 1, 1, 1); 907 | my ($self, $tmpimage, $imagefilename) = @_; 908 | 909 | my $card = $self->session->card; 910 | 911 | my $topfolder = $config->folder($card, $imagefilename); 912 | my $subfolder; 913 | my $subtemplate = $config->subfolder($card, $imagefilename); 914 | 915 | # We can create sub folders, but the top folders should be there: 916 | $config->check_writeable_dir($topfolder); 917 | 918 | if (!$subtemplate || $subtemplate =~ /\A \s* \z/mxi) { 919 | $log->debug("Card '%s' file '%s': Root folder '%s', empty/blank subfolder", 920 | $config->cardname($card), 921 | $imagefilename, 922 | $topfolder); 923 | return $topfolder; 924 | } 925 | 926 | if ($config->subfoldertimesource() ne 'local') { 927 | confess "Sorry, other time sources than 'local' is not implemented yet"; 928 | } 929 | $subfolder = POSIX::strftime($subtemplate, localtime()); 930 | 931 | my $destination = File::Spec->catfile($topfolder, $subfolder); 932 | $log->debug("Destination subdirectory: '%s' -> '%s', full path: '%s'", 933 | $subtemplate, 934 | $subfolder, 935 | $destination); 936 | 937 | # Next, create it. Note that the subfolder may be 938 | # $topfolder/X/Y/Z, not just $topfolder/X, so mkdir one level 939 | # at a time: 940 | my @path_elements = File::Spec->splitdir($subfolder); 941 | my $makedir = $topfolder; 942 | foreach my $pe (@path_elements) { 943 | $makedir = File::Spec->catfile($makedir, $pe); 944 | if (! -e $makedir) { 945 | $log->trace("mkdir '$makedir'"); 946 | mkdir $makedir 947 | or confess "Unable to mkdir '$makedir': $!"; 948 | } 949 | } 950 | 951 | # Final sanity check: 952 | $config->check_writeable_dir($destination); 953 | return $destination; 954 | } 955 | 956 | # We never want to overwrite existing files, but we don't want the 957 | # card to be stuck with files because we're not able to write them 958 | # to disk either. So we receive it, but add .1 (or .2, or .n+1) 959 | # to the filename. The user will have to sort out duplicates 960 | # afterwards. 961 | # 962 | # (We *assume* that if the link() fails, it is because the 963 | # filename already exists.) 964 | sub _link_file { 965 | validate_pos(@_, 1, 1, 1); 966 | my ($self, $tempfile, $destination_name) = @_; 967 | 968 | my $tries = 0; 969 | my $max = 100; 970 | my $dst = $destination_name; 971 | my $done = undef; 972 | 973 | while (!$done && $tries < $max) { 974 | if (link $tempfile, $dst) { 975 | $done = $dst; 976 | $log->debug("'%s' created OK (linked from '%s')", $dst, $tempfile); 977 | } 978 | else { 979 | my $prev_dst = $dst; 980 | $dst = sprintf("%s.%d", $destination_name, ++$tries); 981 | $log->warning("'%s' already exists, trying '%s'", $prev_dst, $dst); 982 | } 983 | } 984 | 985 | confess sprintf("Unable to write '%s': Destination files already there!", 986 | $dst) 987 | unless $done; 988 | 989 | return $dst; 990 | } 991 | 992 | sub _extract_tarfile { 993 | validate_pos(@_, 1); 994 | my ($self) = @_; 995 | 996 | my $tar_cmd = $config->tarcommand; 997 | my $tar_file = $self->tarfile; 998 | 999 | my @files = `$tar_cmd -tf $tar_file`; 1000 | # Remove leading and trailing whitespace from each element: 1001 | foreach my $f (@files) { 1002 | $f =~ s/\A \s*//xg; 1003 | $f =~ s/\s* \z//xg; 1004 | } 1005 | $log->debug("Files in tarball on disk: %s", join(", ", @files)); 1006 | 1007 | confess sprintf("I don't know how to handle tarballs with >1 files! (%s)", 1008 | join(", ", @files)) 1009 | if scalar(@files) > 1; 1010 | 1011 | my $fn = shift @files; 1012 | confess sprintf("Illegal name of file inside tarball: '%s'", $fn) 1013 | unless $fn =~ $RIFEC::File::filename_regexp; 1014 | 1015 | my $tfh = File::Temp->new( 1016 | TEMPLATE => sprintf(".rifec-untarred-%d--%s--XXXXXXXX", $$, $fn), 1017 | DIR => $config->folder( $self->session->card ), 1018 | UNLINK => 0); 1019 | my $tfn = $tfh->filename; 1020 | 1021 | $log->debug("Writing target file '%s' to tempfile '%s'", $fn, $tfn); 1022 | # tar -xOf /tmp/movfile.tar DSC_1720.MOV > fnordmovie.mov 1023 | my $extract_command = "$tar_cmd -xOf $tar_file $fn > $tfn"; 1024 | $log->trace("Extract command: '$extract_command'"); 1025 | { 1026 | # unset SIGCHLD handler, since system() expects to wait on 1027 | # its children: 1028 | local $SIG{CHLD} = ''; 1029 | my $status = system($extract_command); 1030 | confess "Failed to run '$tar_cmd': $!\n" 1031 | if $status == -1; 1032 | confess "Failure exit status from '$tar_cmd': " . $status >> 8 1033 | if $status != 0; 1034 | } 1035 | $tfh->flush() or confess "Unable to flush '$tfn': $!"; 1036 | $tfh->sync() or confess "Unable to sync '$tfn': $!"; 1037 | $tfh->close() or confess "Unable to close '$tfn': $!"; 1038 | 1039 | # Return the filename of the file in the tarball plus the 1040 | # tempfile this file is currently stored in: 1041 | return ($fn, $tfn); 1042 | } 1043 | 1044 | sub extract { 1045 | validate_pos(@_, 1); 1046 | my ($self) = @_; 1047 | 1048 | # Extract the tar file and save the contents to a temp file: 1049 | my ($filename, $tmpfilename) = $self->_extract_tarfile(); 1050 | 1051 | # Create the destination sub folder if necessary: 1052 | my $dest_folder = $self->_subfolder($tmpfilename, $filename); 1053 | 1054 | # Do the hard linking from the final file name to the temp 1055 | my $full_filename = File::Spec->catfile($dest_folder, $filename); 1056 | 1057 | my $outfile = $self->_link_file($tmpfilename, $full_filename); 1058 | 1059 | $log->warning("Destination file '%s' saved as '%s' to avoid collision", 1060 | $full_filename, $outfile) 1061 | unless $outfile eq $full_filename; 1062 | 1063 | $self->stored_file($outfile); # Remember where we put it 1064 | 1065 | $log->debug("Removing tar file '%s'", $self->tarfile()); 1066 | unlink $self->tarfile 1067 | or confess sprintf("Unable to unlink tarfile '%s': $!", 1068 | $self->tarfile); 1069 | 1070 | $log->debug("Removing temp file '%s'", $tmpfilename); 1071 | unlink $tmpfilename 1072 | or confess "Unable to unlink tempfile '$tmpfilename': $!"; 1073 | 1074 | # Chmod it to use the default umask 1075 | chmod 0666 & ~umask(), $self->stored_file 1076 | or $log->warning("Unable to chmod '%s'", $self->file); 1077 | 1078 | $log->info("File '%s' saved", $self->stored_file); 1079 | return 'ok'; 1080 | } 1081 | 1082 | 1; 1083 | } 1084 | 1085 | package RIFEC::Handler { 1086 | use Carp qw(confess); 1087 | use Data::Dumper; 1088 | use Encode qw(); 1089 | use HTTP::Message; 1090 | use HTTP::Status qw(:constants); 1091 | use Params::Validate; 1092 | use Socket qw(); 1093 | use XML::Simple qw(:strict); 1094 | 1095 | sub new { 1096 | my $class = shift; 1097 | 1098 | my $self = {}; 1099 | bless($self, $class); 1100 | 1101 | return $self; 1102 | } 1103 | 1104 | sub session { 1105 | validate_pos(@_, 1, { optional => 1, isa => 'RIFEC::Session' }); 1106 | my ($self, $set) = @_; 1107 | 1108 | $self->{'session'} = $set if @_ > 1; 1109 | return $self->{'session'}; 1110 | } 1111 | 1112 | # We jump through some hoops to make XML::Simple output the SOAP 1113 | # response the way we want it instead of having to template-write 1114 | # the XML ourselves. Most of those hoops are hidden here: 1115 | sub _wrap_response { 1116 | validate_pos(@_, 1, 1, 1); 1117 | my ($self, $blockname, $values) = @_; 1118 | 1119 | $log->trace($blockname . ": " . Dumper($values)); 1120 | 1121 | # { a => b, c => d } --> { a => [ b ], c => [ d ] } 1122 | foreach my $key (keys %$values) { 1123 | if (!ref($values->{$key})) { 1124 | $values->{$key} = [ $values->{$key} ]; 1125 | } 1126 | } 1127 | # Add XML namespace attribute: 1128 | $values->{'xmlns'} = "http://localhost/api/soap/eyefilm"; 1129 | 1130 | my %wrap = ( 1131 | 'SOAP-ENV:Envelope' => { 1132 | 'xmlns:SOAP-ENV' => 'http://schemas.xmlsoap.org/soap/envelope/', 1133 | 'SOAP-ENV:Body' => { 1134 | $blockname => [ $values ] 1135 | }, 1136 | }); 1137 | 1138 | return \%wrap; 1139 | } 1140 | 1141 | # Do basic sanity checking of the parameters coming in. 1142 | # XML::Simple will fail on XML syntax, this sub does some reality 1143 | # checking on the contents. 1144 | sub _extract_params { 1145 | validate_pos(@_, 1, { type => Params::Validate::HASHREF }, 1); 1146 | my ($self, $body, $bodyname) = @_; 1147 | 1148 | # The filename regexp lives in the ::File class since it is 1149 | # used in other places as well 1150 | my $md5sum = qr|\A [a-z0-9]{32} \z|xi; 1151 | my $macaddress = qr|\A [a-z0-9]{12} \z|xi; 1152 | # We are not too concerned with the length of the number: We 1153 | # do syntax checking here, the handling code can take care of 1154 | # the semantics. 1155 | my $number = qr|\A \d+ \z|xi; 1156 | # Again, no too worried about the length of the string, as 1157 | # long as it's syntactically correct: 1158 | my $simplestring = qr|\A [a-z]+ \z|xi; 1159 | 1160 | my %paramspec_of = ( 1161 | "ns1:StartSession" => { 1162 | 'macaddress' => { regex => $macaddress }, 1163 | 'transfermodetimestamp' => { regex => $number }, 1164 | 'cnonce' => { regex => $md5sum }, 1165 | 'transfermode' => { regex => $number }, 1166 | 'productfeatures' => { regex => $number, optional => 1 }, 1167 | }, 1168 | "ns1:GetPhotoStatus" => { 1169 | 'filesize' => { regex => $number }, 1170 | 'flags' => { regex => $number }, 1171 | 'filename' => { regex => $RIFEC::File::filename_regexp }, 1172 | 'macaddress' => { regex => $macaddress }, 1173 | 'credential' => { regex => $md5sum }, 1174 | 'filesignature' => { regex => $md5sum }, 1175 | }, 1176 | "ns1:UploadPhoto" => { 1177 | 'filesize' => { regex => $number }, 1178 | 'flags' => { regex => $number }, 1179 | 'filename' => { regex => $RIFEC::File::filename_regexp }, 1180 | 'macaddress' => { regex => $macaddress }, 1181 | 'fileid' => { regex => $number }, 1182 | 'encryption' => { regex => $simplestring }, 1183 | 'filesignature' => { regex => $md5sum }, 1184 | }, 1185 | "ns1:MarkLastPhotoInRoll" => { 1186 | 'macaddress' => { regex => $macaddress }, 1187 | 'mergedelta' => { regex => $number }, 1188 | }, 1189 | ); 1190 | 1191 | # Params::Validate has checked that $body is a HashRef 1192 | # already, so we can go straight on the keys inside it: 1193 | confess "No element '$bodyname' in body" 1194 | unless exists $body->{$bodyname} && defined $body->{$bodyname}; 1195 | confess "Element '$bodyname' is not a hash ref" 1196 | unless ref($body->{$bodyname}) eq 'HASH'; 1197 | 1198 | Params::Validate::validation_options('stack_skip' => 2); 1199 | my %p = validate( @{[ $body->{$bodyname} ]}, $paramspec_of{$bodyname} ); 1200 | Params::Validate::validation_options('stack_skip' => 1); 1201 | 1202 | return \%p; 1203 | } 1204 | 1205 | sub startsession { 1206 | validate_pos(@_, 1, { type => Params::Validate::HASHREF }); 1207 | my ($self, $soapbody) = @_; 1208 | 1209 | my $params = $self->_extract_params($soapbody, "ns1:StartSession"); 1210 | 1211 | $log->info("StartSession from '%s' (%s)", 1212 | $config->cardname($params->{'macaddress'}), 1213 | $params->{'macaddress'}); 1214 | $log->trace("StartSession: " . Dumper($params)); 1215 | 1216 | my $s = RIFEC::Session->new( 1217 | 'card' => $params->{'macaddress'}, 1218 | 'card_nonce' => $params->{'cnonce'}, 1219 | 'transfermode' => $params->{'transfermode'}, 1220 | 'transfermodetimestamp' => $params->{'transfermodetimestamp'}); 1221 | 1222 | $self->session($s); 1223 | 1224 | return $self->_wrap_response( 1225 | 'StartSessionResponse', 1226 | { 1227 | 'credential' => $s->server_credential(), 1228 | 'snonce' => $s->server_nonce(), 1229 | 'transfermode' => $s->transfermode(), 1230 | 'transfermodetimestamp' => $s->transfermodetimestamp(), 1231 | 'upsyncallowed' => 'false', 1232 | }); 1233 | } 1234 | 1235 | sub getphotostatus { 1236 | validate_pos(@_, 1, { type => Params::Validate::HASHREF }); 1237 | my ($self, $soapbody) = @_; 1238 | 1239 | my $params = $self->_extract_params($soapbody, "ns1:GetPhotoStatus"); 1240 | 1241 | $log->info("GetPhotoStatus for '%s' from '%s' (%s)", 1242 | $params->{'filename'}, 1243 | $config->cardname($self->session->card), 1244 | $self->session->card); 1245 | $log->trace("GetPhotoStatus: " . Dumper($params)); 1246 | 1247 | my $s = $self->session(); 1248 | 1249 | # Verify a valid session & credential: This is the credential 1250 | # check before uploading photos. 1251 | if (lc $params->{'macaddress'} ne lc $s->card()) 1252 | { 1253 | confess sprintf("MAC from card != session MAC (%s != %s)", 1254 | lc $params->{'macaddress'}, 1255 | lc $s->card()); 1256 | } 1257 | if (lc $params->{'credential'} ne lc $s->card_credential()) 1258 | { 1259 | confess sprintf("Card credential invalid (%s != %s)", 1260 | lc $params->{'credential'}, 1261 | lc $s->card_credential()); 1262 | } 1263 | 1264 | $s->authenticated(1); 1265 | 1266 | return $self->_wrap_response( 1267 | 'GetPhotoStatusResponse', 1268 | { 1269 | 'fileid' => $config->counter, 1270 | 'offset' => '0', 1271 | }); 1272 | } 1273 | 1274 | sub init_file_object { 1275 | validate_pos(@_, 1, 1); 1276 | my ($self, $body) = @_; 1277 | 1278 | my $soapbody; 1279 | my $eval_result = eval { 1280 | $soapbody = XML::Simple::XMLin($body, 1281 | ForceArray => 0, 1282 | KeyAttr => []); 1283 | }; 1284 | if (!defined $eval_result) { 1285 | confess "XML::Simple::XMLin died: $@"; 1286 | } 1287 | 1288 | confess "Unable to find SOAP Body in Upload envelope" 1289 | unless (ref($soapbody) eq 'HASH' && 1290 | exists $soapbody->{'SOAP-ENV:Body'}); 1291 | 1292 | my $pi = $self->_extract_params($soapbody->{'SOAP-ENV:Body'}, 1293 | "ns1:UploadPhoto"); 1294 | $log->trace("Upload SoapEnvelope: " . Dumper($pi)); 1295 | 1296 | return RIFEC::File->new( 1297 | 'tarfilename' => $pi->{'filename'}, 1298 | 'size' => $pi->{'filesize'}, 1299 | 'encryption' => $pi->{'encryption'}, 1300 | 'filesignature' => $pi->{'filesignature'}, 1301 | 'session' => $self->session()); 1302 | } 1303 | 1304 | sub read_socket { 1305 | my ($self, $conn, $len) = @_; 1306 | confess "Wrong connection type object" 1307 | unless $conn->isa('HTTP::Daemon::ClientConn'); 1308 | 1309 | my $content = $conn->read_buffer(''); 1310 | my $read_count = length($content); 1311 | my $blocksize = 1024; 1312 | 1313 | my $fdset = ''; 1314 | vec($fdset,fileno($conn),1) = 1; 1315 | 1316 | while ($read_count < $len) { 1317 | $blocksize = $len - $read_count 1318 | if $blocksize > ($len - $read_count); 1319 | 1320 | my $into; 1321 | 1322 | my $n = select($fdset, undef, undef, $config->sockettimeout); 1323 | confess "select() timed out waiting for socket" 1324 | if $n == 0; 1325 | confess "select() returned error: $!" 1326 | if $n < 0; 1327 | 1328 | my $s = sysread($conn, $into, $blocksize); 1329 | confess "Read failed!" 1330 | unless defined $s; 1331 | confess "Reached EOF!" 1332 | if $s == 0; 1333 | 1334 | $content .= $into; 1335 | $read_count += length $into; 1336 | } 1337 | 1338 | if ($read_count > $len) { 1339 | my $tail = substr $content, $len; 1340 | $content = substr $content, 0, $len; 1341 | $conn->read_buffer($tail); 1342 | } 1343 | return $content; 1344 | } 1345 | 1346 | sub stow_away { 1347 | my ($self, $buffer, $keep, $to) = @_; 1348 | 1349 | my $stow; 1350 | my $giveback; 1351 | 1352 | if ($keep == 0) { 1353 | $stow = $buffer; 1354 | $giveback = ''; 1355 | } 1356 | else { 1357 | $stow = substr $buffer, 0, -$keep; 1358 | $giveback = substr $buffer, -$keep; 1359 | } 1360 | 1361 | if (ref($to) eq 'SCALAR') { 1362 | $$to .= $stow; 1363 | } 1364 | elsif (ref($to) eq 'File::Temp') { 1365 | print $to $stow; 1366 | } 1367 | else { 1368 | confess "Need a better place to stow!"; 1369 | } 1370 | return $giveback; 1371 | } 1372 | 1373 | sub read_part { 1374 | validate_pos(@_, 1, 1375 | { isa => 'HTTP::Daemon::ClientConn' }, 1376 | 1, 1, 0); 1377 | my ($self, $conn, $boundary, $maxlen, $to_file) = @_; 1378 | 1379 | my $default_bs = 1024; 1380 | my $overlap = length($boundary) + 8; # \r\n*2 + --*2 = 8 1381 | my $out_var; 1382 | my $to = $to_file || \$out_var; 1383 | 1384 | my $header = ''; 1385 | my $buf = ''; 1386 | my $read_len = 0; 1387 | 1388 | READ: 1389 | while ($read_len < $maxlen) { 1390 | my $left = $maxlen - $read_len; 1391 | my $readblock = $left < $default_bs ? $left : $default_bs; 1392 | 1393 | my $add = $self->read_socket($conn, $readblock); 1394 | 1395 | $buf .= $add; 1396 | $read_len += length($add); 1397 | 1398 | # Are we done? 1399 | if ($buf =~ /\A (.*?) (\r?\n)? -- \Q$boundary\E (--)? \r?\n (.*) \z/msxi) { 1400 | my ($keep, $tail) = ($1, $4); 1401 | 1402 | # The tail needs to go back to the front of the read buffer: 1403 | $conn->read_buffer($tail . $conn->read_buffer('')); 1404 | $read_len -= length($tail); 1405 | 1406 | # If the body is empty or small enough to match on the 1407 | # first round, we need to chop off the header: 1408 | if (!$header && 1409 | $keep =~ s/\A (.*?) \r?\n \r?\n//msxi) { 1410 | $header = $1; 1411 | } 1412 | 1413 | $self->stow_away($keep, 0, $to); 1414 | last READ; 1415 | } 1416 | elsif (!$header && 1417 | $buf =~ s/\A (.*?) \r?\n \r?\n//msxi) 1418 | { 1419 | $header = $1; 1420 | } 1421 | # Don't start stowing away stuff until we have found the 1422 | # header separator 1423 | if ($header) 1424 | { 1425 | $buf = $self->stow_away($buf, $overlap, $to); 1426 | } 1427 | } 1428 | return $header, $out_var, $maxlen-$read_len; 1429 | } 1430 | 1431 | sub upload { 1432 | validate_pos(@_, 1, 1433 | { isa => 'HTTP::Daemon::ClientConn' }, 1434 | { isa => 'HTTP::Request' }); 1435 | my ($self, $conn, $request) = @_; 1436 | 1437 | $log->info("Upload from '%s' (%s)", 1438 | $config->cardname($self->session->card), 1439 | $self->session->card); 1440 | 1441 | confess "Session un-authenticated, upload is a no-go" 1442 | unless $self->session->authenticated; 1443 | 1444 | my $left = $request->header('Content-Length'); 1445 | my $boundary; 1446 | if ($request->header('Content-Type') =~ 1447 | m|\A multipart/form-data; \s* boundary=([^\s;,]+) [,;]? \s* \z|xi) { 1448 | # This is not very general or robust MIME parsing - but 1449 | # then again, we are not a general SOAP server. 1450 | $boundary = $1; 1451 | } 1452 | else { 1453 | confess sprintf("Unrecognized Content-Type header '%s'", 1454 | $request->header('Content-Type')); 1455 | } 1456 | 1457 | my ($phead, $pbody); 1458 | # Swallow everything up to and including the starting 1459 | # delimiter: 1460 | (undef, undef, $left) = $self->read_part($conn, $boundary, $left); 1461 | 1462 | # Process the SOAPENVELOPE part: 1463 | $log->trace("Upload: Processing SOAPENVELOPE part"); 1464 | ($phead, $pbody, $left) = $self->read_part($conn, $boundary, $left); 1465 | 1466 | confess "Unable to verify start of SOAPENVELOPE part" 1467 | unless $phead =~ / name="SOAPENVELOPE"/; 1468 | 1469 | my $file = $self->init_file_object($pbody); 1470 | 1471 | # Process the FILENAME part, ie. the file itself: 1472 | $log->trace("Upload: Processing FILENAME part"); 1473 | my $recv_fh = $file->receiver_filehandle($file->tarfilename); 1474 | 1475 | ($phead, undef, $left) = $self->read_part($conn, $boundary, $left, $recv_fh); 1476 | $recv_fh->close() 1477 | or confess "Unable to close receiver FH: $!"; 1478 | 1479 | confess "Unable to verify start of FILENAME part" 1480 | unless $phead =~ / name="FILENAME"/; 1481 | 1482 | confess "Unable to extract filename from part header" 1483 | unless my ($fn) = $phead =~ /filename="(.*?)"/x; 1484 | 1485 | confess "File name differs from RIFEC::File state" 1486 | unless $fn eq $file->tarfilename(); 1487 | 1488 | # Last comes the INTEGRITYDIGEST part: 1489 | $log->trace("Upload: Processing INTEGRITYDIGEST part"); 1490 | ($phead, $pbody, $left) = $self->read_part($conn, $boundary, $left); 1491 | 1492 | confess "Unable to verify start of INTEGRITYDIGEST part" 1493 | unless $phead =~ / name="INTEGRITYDIGEST"/; 1494 | 1495 | $file->integritydigest($pbody); 1496 | 1497 | # Should we crash if $file->check() fails? I am thinking not: 1498 | # We log a warning and tell the card whether the operation 1499 | # succeeded or not anyway, so I can't see any extra value 1500 | # added by confess(). 1501 | my $ok = $file->check() && $file->extract(); 1502 | 1503 | return $self->_wrap_response( 1504 | 'UploadPhotoResponse', 1505 | { 1506 | 'success' => $ok ? 'true' : 'false', 1507 | }); 1508 | } 1509 | 1510 | sub marklastphotoinroll { 1511 | validate_pos(@_, 1, { type => Params::Validate::HASHREF }); 1512 | my ($self, $soapbody) = @_; 1513 | 1514 | my $params = $self->_extract_params($soapbody, "ns1:MarkLastPhotoInRoll"); 1515 | 1516 | $log->info("MarkLastPhotoInRoll from '%s' (%s)", 1517 | $config->cardname($self->session->card), 1518 | $self->session->card); 1519 | $log->trace("MarkLastPhotoInRoll: " . Dumper($params)); 1520 | 1521 | # As far as I can figure out, there is not much for us to do 1522 | # here. 1523 | return $self->_wrap_response('MarkLastPhotoInRollResponse', {}); 1524 | } 1525 | 1526 | sub _make_http_reply { 1527 | validate_pos(@_, (1) x 4); 1528 | my ($self, $status, $message, $body) = @_; 1529 | 1530 | # Enforce CRLF: 1531 | $body =~ s/ ([^\r]) \n /$1\r\n/gx; 1532 | my $raw = Encode::encode_utf8($body); 1533 | 1534 | my $header = HTTP::Headers->new(); 1535 | 1536 | $header->content_type ('text/xml'); 1537 | $header->content_type_charset ('UTF-8'); 1538 | $header->content_length (length($raw)); 1539 | $header->server ('rifec.pl'); 1540 | $header->date (time); 1541 | $header->header ('pragma' => 'no-cache'); 1542 | 1543 | return HTTP::Response->new($status, $message, $header, $raw); 1544 | } 1545 | 1546 | sub dispatch { 1547 | validate_pos(@_, 1, 1548 | { isa => 'HTTP::Request' }, 1549 | { isa => 'HTTP::Daemon::ClientConn' }); 1550 | my ($self, $request, $conn) = @_; 1551 | 1552 | my $reply; 1553 | my %handlerof = ('"urn:StartSession"' => \&startsession, 1554 | '"urn:GetPhotoStatus"' => \&getphotostatus, 1555 | '"urn:MarkLastPhotoInRoll"' => \&marklastphotoinroll); 1556 | 1557 | my $eval_result = eval { 1558 | my $answer; 1559 | 1560 | if ($request->method eq 'POST' && 1561 | $request->uri->path eq "/api/soap/eyefilm/v1") 1562 | { 1563 | my $action = $request->header('SOAPAction'); 1564 | my $length = $request->header('Content-Length'); 1565 | 1566 | my $content = $self->read_socket($conn, $length); 1567 | 1568 | my $body; 1569 | my $xml_eval_result = eval { 1570 | $body = XML::Simple::XMLin($content, 1571 | ForceArray => 0, 1572 | KeyAttr => []); 1573 | }; 1574 | if (!defined $xml_eval_result) { 1575 | confess "XML::Simple::XMLin died: $@"; 1576 | } 1577 | 1578 | if (ref($handlerof{$action}) eq 'CODE') { 1579 | $answer = $handlerof{$action}->($self, $body->{'SOAP-ENV:Body'}); 1580 | } 1581 | else { 1582 | confess "Found no handler for [$action]"; 1583 | } 1584 | } 1585 | elsif ($request->method eq 'POST' && 1586 | $request->uri->path eq "/api/soap/eyefilm/v1/upload") 1587 | { 1588 | $answer = $self->upload($conn, $request); 1589 | } 1590 | else { 1591 | confess sprintf("Unknown method/path combo: '%s' '%s'", 1592 | $request->method, 1593 | $request->uri->path); 1594 | } 1595 | 1596 | $reply = $self->_make_http_reply(HTTP_OK, "OK", 1597 | XML::Simple::XMLout($answer, 1598 | KeepRoot => 1, 1599 | XMLDecl => 1, 1600 | KeyAttr => [])); 1601 | }; 1602 | if (!defined $eval_result) { 1603 | $log->warning("Died in request handling: " . $@); 1604 | $reply = $self->_make_http_reply(HTTP_INTERNAL_SERVER_ERROR, 1605 | "Internal server error", 1606 | "My handler died :("); 1607 | } 1608 | return $reply; 1609 | } 1610 | 1611 | 1; 1612 | } 1613 | 1614 | # 1615 | # End of class declarations 1616 | # 1617 | 1618 | use Carp qw(confess); 1619 | use Data::Dumper; 1620 | use Getopt::Long; 1621 | use HTTP::Daemon; 1622 | use HTTP::Status; 1623 | use Pod::Usage; 1624 | use Proc::Daemon; 1625 | 1626 | # A plain sub containing the listen/fork loop: 1627 | sub run_listener { 1628 | local $SIG{CHLD} = 'IGNORE'; 1629 | 1630 | my $d = HTTP::Daemon->new(LocalPort => $config->port(), 1631 | ReuseAddr => 1) 1632 | || confess "Unable to instantiate HTTP Daemon: $!"; 1633 | $log->info("Listening on %s", $d->url()); 1634 | 1635 | while (my $conn = $d->accept()) 1636 | { 1637 | $log->debug("Connect from %s:%d", $conn->peerhost(), $conn->peerport()); 1638 | $config->bump_counter(); 1639 | 1640 | my $pid = fork(); 1641 | if ($pid == 0) { # Child 1642 | $conn->timeout($config->sockettimeout()); 1643 | my $handler = RIFEC::Handler->new(); 1644 | 1645 | while (my $req = $conn->get_request(1)) 1646 | { 1647 | $log->debug("%s:%d -> %s %s", 1648 | $conn->peerhost(), $conn->peerport(), 1649 | $req->method, $req->uri->path); 1650 | $log->trace("Request headers: " . 1651 | Dumper([ split /\r?\n/, $req->headers_as_string() ])); 1652 | 1653 | # All sanity checking is done in the handler 1654 | my $http_reply = $handler->dispatch($req, $conn); 1655 | 1656 | $conn->send_response($http_reply); 1657 | } 1658 | $log->debug("Closed connection!"); 1659 | 1660 | $conn->close(); 1661 | undef($conn); 1662 | undef($handler); 1663 | exit 0; 1664 | } 1665 | else { # Parent 1666 | $log->debug("Child %d forked, going back to accept()", $pid); 1667 | } 1668 | } 1669 | } 1670 | 1671 | # We don't support a lot of command line options, we defer to the 1672 | # config file for configuration. However, we need a --help, and a 1673 | # possibility to set custom config files: 1674 | 1675 | my $cf_file; 1676 | my $daemonize; 1677 | 1678 | GetOptions('help|h|?' => sub { pod2usage(0) }, 1679 | 'config|c=s' => \$cf_file, 1680 | 'daemonize|d' => \$daemonize) 1681 | or pod2usage(2); 1682 | 1683 | $config = RIFEC::Config->new($cf_file); 1684 | $log = RIFEC::Log->new(); 1685 | 1686 | $config->say_hello(); 1687 | 1688 | if ($daemonize) { 1689 | if (!$config->logfile()) { 1690 | $log->warning("Daemon mode enabled, but no logfile specified: " . 1691 | "Logs and error messages will disappear, " . 1692 | "consider adding LogFile=/path/to/file to your config"); 1693 | } 1694 | Proc::Daemon::Init(); 1695 | $log->open(); # since Proc::Daemon::Init closes all open fh's 1696 | } 1697 | 1698 | run_listener(); 1699 | 1700 | __END__ 1701 | 1702 | =head1 NAME 1703 | 1704 | rifec.pl - receive and store files from Eye-Fi cards 1705 | 1706 | =head1 SYNOPSIS 1707 | 1708 | rifec.pl [--help|-h|-?] [--config configfile] [--daemonize|-d] 1709 | 1710 | Options: 1711 | --help|-h|-? Print this help message 1712 | --config|-c CFGFILE Use CFGFILE instead of default config location 1713 | --daemonize|-d Run as a daemon in the background 1714 | 1715 | For modifying the behaviour of the program in other ways, it is 1716 | necessary to use the config file. See the file C, which 1717 | contains a commented example configuration. 1718 | 1719 | =cut 1720 | --------------------------------------------------------------------------------