1#! @im_path_perl@ 2################################################################ 3### 4### imhist 5### 6### Author: Internet Message Group <img@mew.org> 7### Created: Jul 6, 1997 8### Revised: Apr 23, 2007 9### 10 11BEGIN { 12 @im_my_siteperl@ 13 @im_src_siteperl@ 14}; 15 16$Prog = 'imhist'; 17my $VERSION_DATE = "20161010"; 18my $VERSION_NUMBER = "153"; 19my $VERSION = "${Prog} version ${VERSION_DATE}(IM${VERSION_NUMBER})"; 20my $VERSION_INFORMATION = "${Prog} (IM ${VERSION_NUMBER}) ${VERSION_DATE} 21Copyright (C) 1999 IM developing team 22This is free software; see the source for copying conditions. There is NO 23warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 24"; 25 26## 27## Require packages 28## 29 30use IM::Config; 31use IM::Address; 32use IM::History; 33use IM::Message; 34use IM::Util; 35use integer; 36use strict; 37use vars qw($Prog $EXPLANATION @OptConfig 38 @Hdr 39 $opt_lookup $opt_remove $opt_msg $opt_dump $opt_add 40 $opt_subfolders $opt_verbose $opt_debug $opt_help $opt_version); 41 42## 43## Environments 44## 45 46$EXPLANATION = "$VERSION 47treat mail/news history database 48 49Usage: imhist [OPTIONS] 50"; 51 52@OptConfig = ( 53 'lookup;s;;' => 'Look up an entry for specified message-id', 54 'remove;s;;' => 'Remove whole information on specified message-id', 55 'msg;s;;' => 'Message to be deleted if multiple in database', 56 'dump;b;;' => 'Dump database just for debugging', 57 'add;f;;' => 'Add information of messages in a specified folder', 58 'subfolders;b;;' => 'Descend sub folders recursively (option for --add)', 59 'verbose;b;;' => 'With verbose messages', 60 'debug;d;;' => "With debug message", 61 'help;b;;' => "Display this help and exit", 62 'version,V;b;;' => "Output version information and exit", 63 ); 64 65## 66## Profile and option processing 67## 68 69init_opt(\@OptConfig); 70read_cfg(); 71read_opt(\@ARGV); # help? 72print("${VERSION_INFORMATION}") && exit $EXIT_SUCCESS if $opt_version; 73help($EXPLANATION) && exit $EXIT_SUCCESS if $opt_help; 74debug_option($opt_debug) if $opt_debug; 75 76## 77## Main 78## 79 80if (msgdbfile() eq '') { 81 im_die("MsgDBFile is not defined.\n"); 82} 83if ($opt_lookup ne '') { 84 exit $EXIT_ERROR if (history_open(1) < 0); 85# unless ($opt_lookup =~ /^<.*>$/) { 86# im_warn("Message-ID should be surrounded by <>.\n"); 87# exit $EXIT_ERROR; 88# } 89 my $msg = history_lookup($opt_lookup, LookUpMsg); 90 if ($msg eq '') { 91 im_info("no entry found for $opt_lookup\n"); 92 exit $EXIT_ERROR; 93 } else { 94 print $msg . "\n"; 95 } 96 history_close(); 97} elsif ($opt_remove ne '') { 98 exit $EXIT_ERROR if (history_open(1) < 0); 99# unless ($opt_lookup =~ /^<.*>$/) { 100# im_warn("Message-ID should be surrounded by <>.\n"); 101# exit $EXIT_ERROR; 102# } 103 my $num = history_delete($opt_remove, $opt_msg); 104 if ($num < 0) { 105 im_warn("no entry found for $opt_remove\n"); 106 exit $EXIT_ERROR; 107 } 108 if ($opt_msg ne '' && $num > 0) { 109 im_info("message $opt_msg for $opt_remove deleted\n"); 110 } else { 111 im_info("entry for $opt_remove deleted\n"); 112 } 113 history_close(); 114} elsif ($opt_dump) { 115 exit $EXIT_ERROR if (history_open(0) < 0); 116 history_dump(); 117 history_close(); 118} elsif ($opt_add ne '') { 119 my $p = expand_path($opt_add); 120 if (-f $p) { 121 # single file 122 if (history_open(1) < 0) { 123 exit $EXIT_ERROR; 124 } 125 add_msg_info($p, $opt_add); 126 history_close(); 127 } elsif (-d $p) { 128 # folder 129 if (history_open(1) < 0) { 130 exit $EXIT_ERROR; 131 } 132 add_folder_info($p, $opt_add); 133 history_close(); 134 } else { 135 im_warn("no message found to add.\n"); 136 exit $EXIT_ERROR; 137 } 138} else { 139 im_warn("no option specified.\n"); 140 exit $EXIT_ERROR; 141} 142 143exit $EXIT_SUCCESS; 144 145sub add_msg_info($$) { 146 my($path, $msg) = @_; 147 local(@Hdr) = (); 148 if (im_open(\*MSG, "<$path")) { 149 &read_header(\*MSG, \@Hdr, 0); 150 my $mid = &header_value(\@Hdr, 'Message-ID'); 151# my $dt = &header_value(\@Hdr, 'Date'); 152 my $ver = &extract_addr(&header_value(\@Hdr, 'Mime-Version')); 153 $ver =~ s/\s//g; 154 my $master = ''; 155 if ($ver eq '1.0') { 156 my $ct = &header_value(\@Hdr, 'Content-Type') . ';'; 157 $ct =~ s/\s//g; 158 if ($ct =~ m|^Message/partial;(.*;)?id=([^;]+);|i) { 159 $master = $2; 160 $master =~ s/^"(.*)"$/$1/; 161 } 162 } 163 if ($mid ne '') { 164 history_store($mid, $msg); 165 history_store("partial:$master", $mid) if ($master ne ''); 166 } 167 close (MSG); 168 return 0; 169 } 170 return -1; 171} 172 173sub add_folder_info($$) { 174 my($dir, $folder) = @_; 175 $dir =~ s|/$||; 176 im_info("Entering folder $dir\n"); 177 chdir ($dir); 178 unless (opendir(FOLDER, $dir)) { 179 im_warn("can't read $dir\n"); 180 return -1; 181 } 182 my @lower = (); 183 my $f; 184 foreach $f (readdir(FOLDER)) { 185 if ($f eq '.' || $f eq '..') { 186 } elsif ($f =~ /^\d+$/ && -f $f) { 187 print(" $f\n"); 188 add_msg_info($f, "$folder/$f"); 189 } elsif (-d $f) { 190 push(@lower, $f); 191 } 192 } 193 closedir(FOLDER); 194 if ($opt_subfolders eq '1') { 195 my $l; 196 foreach $l (@lower) { 197 if ($folder eq '+') { 198 add_folder_info("$dir/$l", "+$l"); 199 } else { 200 add_folder_info("$dir/$l", "$folder/$l"); 201 } 202 } 203 } 204} 205 206__END__ 207 208=head1 NAME 209 210imhist - treat mail/news history database 211 212=head1 SYNOPSIS 213 214B<imhist> [OPTIONS] 215 216=head1 DESCRIPTION 217 218The I<imhist> command handles mail/news history database. 219 220This command is provided by IM (Internet Message). 221 222=head1 OPTIONS 223 224=over 5 225 226=item I<-l, --lookup=STRING> 227 228Look up an entry for specified message-id. 229 230=item I<-r, --remove=STRING> 231 232Remove whole information on specified message-id. 233 234=item I<-m, --msg=STRING> 235 236Message to be deleted if multiple in database. 237 238=item I<-d, --dump={on,off}> 239 240Dump database just for debugging. 241 242=item I<-a, --add=FOLDER> 243 244Add information of messages in a specified folder. 245 246=item I<-s, --subfolders={on,off}> 247 248Descend sub folders recursively (option for --add). 249 250=item I<-v, --verbose={on,off}> 251 252Print verbose messages when running. 253 254=item I<--debug=DEBUG_OPTION> 255 256Print debug messages when running. 257 258=item I<-h, --help> 259 260Display help message and exit. 261 262=item I<--version> 263 264Output version information and exit. 265 266=back 267 268=head1 COPYRIGHT 269 270IM (Internet Message) is copyrighted by IM developing team. 271You can redistribute it and/or modify it under the modified BSD 272license. See the copyright file for more details. 273 274=cut 275 276### Copyright (C) 1997, 1998, 1999 IM developing team 277### All rights reserved. 278### 279### Redistribution and use in source and binary forms, with or without 280### modification, are permitted provided that the following conditions 281### are met: 282### 283### 1. Redistributions of source code must retain the above copyright 284### notice, this list of conditions and the following disclaimer. 285### 2. Redistributions in binary form must reproduce the above copyright 286### notice, this list of conditions and the following disclaimer in the 287### documentation and/or other materials provided with the distribution. 288### 3. Neither the name of the team nor the names of its contributors 289### may be used to endorse or promote products derived from this software 290### without specific prior written permission. 291### 292### THIS SOFTWARE IS PROVIDED BY THE TEAM AND CONTRIBUTORS ``AS IS'' AND 293### ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 294### IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 295### PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE TEAM OR CONTRIBUTORS BE 296### LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 297### CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 298### SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR 299### BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, 300### WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE 301### OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN 302### IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 303 304### Local Variables: 305### mode: perl 306### End: 307