forked from svn2github/freearc
-
Notifications
You must be signed in to change notification settings - Fork 1
/
ArcExtract.hs
284 lines (255 loc) · 14 KB
/
ArcExtract.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
----------------------------------------------------------------------------------------------------
---- Ðåàëèçàöèÿ êîìàíä ðàñïàêîâêè è ïîëó÷åíèÿ ëèñòèíãà àðõèâà ----
----------------------------------------------------------------------------------------------------
module ArcExtract ( runArchiveExtract
, runArchiveList
, runCommentWrite
, formatDateTime
) where
import Prelude hiding (catch)
import Control.Exception
import Control.Monad
import Data.List
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal.Alloc
import Numeric
import System.IO.Unsafe
import System.Posix.Internals
import Process
import Utils
import Files
import FileInfo
import Charsets (i18n)
import Errors
import Compression (aINIT_CRC, updateCRC, finishCRC, join_compressor)
import Options
import UI
import ArhiveStructure
import ArhiveDirectory
import ArcvProcessExtract
-- |Îáîáù¸ííàÿ êîìàíäà ðàñïàêîâêè àðõèâà
runArchiveExtract pretestArchive
command@Command{ cmd_arcname = arcname
, cmd_archive_filter = archive_filter
, opt_arc_basedir = arc_basedir
, opt_disk_basedir = disk_basedir
, opt_arccmt_file = arccmt_file
, opt_unParseFile = unParseFile
} = do
-- Ñóïåðýêîíîìèÿ ïàìÿòè: find_archives -> buffer 10_000 -> read_dir -> buffer 10_000 -> arcExtract
doFinally uiDoneArchive2 $ do
uiStartArchive command [] -- ñîîáùèòü ïîëüçîâàòåëþ î íà÷àëå îáðàáîòêè î÷åðåäíîãî àðõèâà
uiStage "0249 Reading archive directory"
command <- (command.$ opt_cook_passwords) command ask_passwords -- ïîäãîòîâèòü ïàðîëè â êîìàíäå ê èñïîëüçîâàíèþ
let openArchive = archiveReadInfo command arc_basedir disk_basedir archive_filter (pretestArchive command)
bracketCtrlBreak "arcClose:ArcExtract" (openArchive arcname) (arcClose)$ \archive -> do
uiPrintArcComment (arcComment archive) -- Íàïå÷àòàòü êîììåíòàðèé
when (arccmt_file/="-" && arccmt_file/="--") $ -- è çàïèñàòü åãî â ôàéë, óêàçàííûé îïöèåé -z
unParseFile 'c' arccmt_file (arcComment archive)
arcExtract command archive
uiDoneArchive -- íàïå÷àòàòü è âåðíóòü â âûçûâàþùóþ ïðîöåäóðó ñòàòèñòèêó âûïîëíåíèÿ êîìàíäû
-- |Ðàñïàêîâêà àðõèâà
arcExtract command arcinfo = do
-- Ïðîöåäóðà, èñïîëüçóåìàÿ äëÿ îáðàáîòêè êàæäîãî ôàéëà
let process_file = case (cmd_name command) of
"t" -> test_file
_ -> extract_file (fpFullname.fiDiskName) command
-- Îòîáðàçèòü â UI îáùèé îáú¸ì ðàñïàêîâûâàåìûõ ôàéëîâ è îáú¸ì óæå ðàñïàêîâàííîãî êàòàëîãà àðõèâà
uiStartProcessing (map cfFileInfo (arcDirectory arcinfo)) (arcDataBytes arcinfo) (arcDataCBytes arcinfo)
uiStartDirectory
uiUnpackedBytes (arcDirBytes arcinfo)
uiCompressedBytes (arcDirCBytes arcinfo)
uiStartFiles 0
-- Ñîçäàäèì ïðîöåññ äëÿ ðàñïàêîâêè ôàéëîâ è ãàðàíòèðóåì åãî êîððåêòíîå çàâåðøåíèå
bracket (runAsyncP$ decompress_PROCESS command (uiCompressedBytes.i))
( \decompress_pipe -> do sendP decompress_pipe Nothing; joinP decompress_pipe)
$ \decompress_pipe -> do
-- Ðàñïàêîâàòü êàæäûé ðàñïàêîâûâàåìûé ôàéë è âûðóãàòüñÿ íà íåðàñïàêîâûâàåìûå
let (filesToSkip, filesToExtract) = partition isCompressedFake (arcDirectory arcinfo)
for filesToExtract (process_file decompress_pipe) -- runP$ enum_files |> decompress |> write_files
unless (null filesToSkip)$ do registerWarning$ SKIPPED_FAKE_FILES (length filesToSkip)
-- |Òåñòèðîâàíèå îäíîãî ôàéëà èç àðõèâà
test_file decompress_pipe compressed_file = do
uiStartFile (cfFileInfo compressed_file)
run_decompress decompress_pipe compressed_file (\buf size -> return ())
return ()
-- |Ðàñïàêîâêà îäíîãî ôàéëà èç àðõèâà
extract_file filename_func command decompress_pipe compressed_file = do
let fileinfo = cfFileInfo compressed_file
filename = filename_func fileinfo
if (fiIsDir fileinfo)
then do uiStartFile fileinfo
createDirectoryHierarchy filename
else do
-- Ïðîäîëæèòü ïðè óñëîâèè, ÷òî ýòîò ôàéë ïîçâîëåíî ðàñïàêîâàòü
whenM (can_be_extracted command filename fileinfo)$ do
uiStartFile fileinfo
buildPathTo filename
outfile <- fileCreate filename
let closeOutfile ok = do -- Ïðîöåäóðà, âûïîëíÿåìàÿ ïîñëå ðàñïàêîâêè ôàéëà èëè ïðè âûõîäå ïî ^Break
fileClose outfile -- to do: åñëè èñïîëüçóåòñÿ fileSetSize, òî èçìåíèòü ðàçìåð ôàéëà â ñîîòâåòñòâèè ñ êîëè÷åñòâîì ðåàëüíî ðàñïàêîâàííûõ áàéò
if ok || opt_keep_broken command
then do setFileDateTimeAttr filename fileinfo -- Ðàñïàêîâàíî óñïåøíî èëè íóæíî ñîõðàíÿòü äàæå ôàéëû, ðàñïàêîâàííûå ñ îøèáêàìè
when (opt_clear_archive_bit command) $ do
clearArchiveBit filename -- Îïöèÿ -ac - î÷èñòèòü àòðèáóò Archive ïîñëå ðàñïàêîâêè
else fileRemove filename -- Óäàëèòü ôàéë, ðàñïàêîâàííûé ñ îøèáêàìè
do --fileSetSize outfile (fiSize fileinfo) -- Ïðèëè÷íàÿ ÎÑ ïðè ýòîì âûäåëèò íà äèñêå ìåñòî äëÿ ôàéëà îäíèì êóñêîì
handleCtrlBreak "closeOutfile" (closeOutfile False) $ do
ok <- run_decompress decompress_pipe compressed_file (fileWriteBuf outfile)
closeOutfile ok
-- |Ýòà ôóíêöèÿ îïðåäåëÿåò - ìîæíî ëè èçâëå÷ü ôàéë èç àðõèâà?
-- Îòâåò çàâèñèò îò 1) èñïîëüçîâàííûõ îïöèé (-u/-f/-sync)
-- 2) íàëè÷èÿ íà äèñêå ïðåäûäóùåãî ôàéëà
-- 3) òîãî, êàêîé èç ôàéëîâ ñâåæåå - íà äèñêå èëè â àðõèâå
-- 4) çíà÷åíèÿ îïöèé "-o" è "y"
-- 5) îòâåòà ïîëüçîâàòåëÿ íà çàïðîñ î ïåðåçàïèñè ôàéëà
--
can_be_extracted cmd filename arcfile = do
diskfile_exist <- fileExist filename
if not diskfile_exist -- Åñëè ôàéë íà äèñêå íå ñóùåñòâóåò
then return (opt_update_type cmd /= 'f') -- òî èçâëå÷ü ôàéë èç àðõèâà ìîæíî âî âñåõ ñëó÷àÿõ, êðîìå '-f'
else do
fileWithStatus "getFileInfo" filename $ \p_stat -> do
diskFileIsDir <- stat_mode p_stat >>== s_isdir
diskFileTime <- stat_mtime p_stat
diskFileSize <- if diskFileIsDir then return 0
else stat_size p_stat
let arcfile_newer = fiTime arcfile > diskFileTime -- ôàéë â àðõèâå ñâåæåå, ÷åì íà äèñêå?
let overwrite = case (opt_update_type cmd) of
'f' -> arcfile_newer
'u' -> arcfile_newer
's' -> error "--sync can't be used on extract"
'a' -> True
if not overwrite then return False else do
askOverwrite filename diskFileSize diskFileTime arcfile (opt_overwrite cmd) arcfile_newer
{-# NOINLINE run_decompress #-}
-- |Ðàñïàêîâêà ôàéëà èç àðõèâà ñ ïðîâåðêîé CRC
run_decompress decompress_pipe compressed_file write_data = do
crc <- ref aINIT_CRC -- Èíèöèàëèçèðóåì çíà÷åíèå CRC
let writer buf len = do
uiUnpackedBytes (i len) -- Èíôîðìèðóåì ïîëüçîâàòåëÿ î õîäå ðàñïàêîâêè
uiUpdateProgressIndicator len -- -.-
crc .<- updateCRC buf len -- Îáíîâèì CRC ñîäåðæèìûì áóôåðà
write_data buf len -- Çàïèøåì äàííûå â ôàéë
send_backP decompress_pipe () -- È âîçâðàòèì èñïîëüçîâàííûé áóôåð
decompress_file decompress_pipe compressed_file writer
acrc <- val crc >>== finishCRC -- Âû÷èñëèì îêîí÷àòåëüíîå çíà÷åíèå CRC
when (cfCRC compressed_file /= acrc) $ do
registerWarning$ BAD_CRC (fpFullname$ fiStoredName$ cfFileInfo compressed_file)
return (cfCRC compressed_file == acrc) -- Âîçâðàòèòü True, åñëè âñ¸ îê
----------------------------------------------------------------------------------------------------
---- Çàïèñü êîììåíòàðèÿ ê àðõèâó â ôàéë (êîìàíäà "cw") ----
----------------------------------------------------------------------------------------------------
-- |Ðåàëèçàöèÿ êîìàíäû "cw" - çàïèñü êîììåíòàðèÿ ê àðõèâó â ôàéë
runCommentWrite command@Command{ cmd_filespecs = filespecs
, cmd_arcname = arcname
, opt_unParseFile = unParseFile
} = do
doFinally uiDoneArchive2 $ do
when (length filespecs /= 1) $
registerError$ CMDLINE_SYNTAX "cw archive outfile"
let [outfile] = filespecs
command <- (command.$ opt_cook_passwords) command ask_passwords -- ïîäãîòîâèòü ïàðîëè â êîìàíäå ê èñïîëüçîâàíèþ
printLineLn$ "Writing archive comment of "++arcname++" to "++outfile
bracket (archiveReadFooter command arcname) (archiveClose.fst) $ \(_,footer) -> do
unParseFile 'c' outfile (ftComment footer)
return (0,0,0,0)
----------------------------------------------------------------------------------------------------
---- Ïå÷àòü ëèñòèíãà àðõèâà: ----
---- - äëÿ ïîëüçîâàòåëÿ (êîìàíäà "l") ----
---- - äëÿ ñîçäàíèÿ ôàéë-ëèñòîâ (êîìàíäà "lb") ----
---- - äëÿ äðóãèõ ïðîãðàìì (êîìàíäà "v") ----
---------------------------------------------------------------------------------------------------
-- |Îáîáù¸ííàÿ êîìàíäà ïîëó÷åíèÿ ëèñòèíãà àðõèâà
runArchiveList pretestArchive
command@Command{ cmd_arclist = arclist
, cmd_arcname = arcname
, opt_arc_basedir = arc_basedir
, cmd_archive_filter = archive_filter
} = do
command <- (command.$ opt_cook_passwords) command ask_passwords -- ïîäãîòîâèòü ïàðîëè â êîìàíäå ê èñïîëüçîâàíèþ
bracket (archiveReadInfo command arc_basedir "" archive_filter (pretestArchive command) arcname) (arcClose) $
archiveList command (null$ tail arclist)
-- |Ëèñòèíã àðõèâà
archiveList command @ Command{ cmd_name = cmd, cmd_arcname = arcname }
show_empty
arc @ ArchiveInfo{ arcDirectory = directory } = do
let files = length directory
bytes = sum$ map (fiSize.cfFileInfo) directory
when (files>0 || show_empty) $ do
doFinally uiDoneArchive2 $ do
uiStartArchive command [] -- Ñîîáùèòü ïîëüçîâàòåëþ î íà÷àëå îáðàáîòêè î÷åðåäíîãî àðõèâà
let list line1 line2 list_func linelast = do
uiPrintArcComment (arcComment arc)
myPutStrLn line1
myPutStrLn line2
compsize <- list_func
myPutStrLn linelast
myPutStr$ show3 files ++ " files, " ++ show3 bytes ++ " bytes, " ++ show3 compsize ++ " compressed"
case cmd of
"l" -> list "Date/time Size Filename"
"----------------------------------------"
(myMapM terse_list directory)
"----------------------------------------"
"v" -> list "Date/time Attr Size Packed CRC Filename"
"-----------------------------------------------------------------------------"
(myMapM verbose_list directory)
"-----------------------------------------------------------------------------"
"lb"-> myPutStr$ joinWith "\n"$ map filename directory
"lt"-> list " Pos Size Compressed Files Method"
"-----------------------------------------------------------------------------"
(do mapM_ data_block_list (arcDataBlocks arc)
return (sum$ map blCompSize (arcDataBlocks arc)))
"-----------------------------------------------------------------------------"
return (1, files, bytes, -1)
-- |Èìÿ ôàéëà
filename = fpFullname . fiStoredName . cfFileInfo
-- |Äîáàâëÿåò ê êîìàíäàì ëèñòèíãà èíôîðìàöèþ î ñæàòûõ ðàçìåðàõ ñîëèä-áëîêîâ
myMapM f = go 0 True undefined
where
go total first lastSolidBlock [] = return total
go total first lastSolidBlock (file:rest) = do
let solidBlock = cfArcBlock file
let compsize = if first || solidBlock /= lastSolidBlock
then (blCompSize solidBlock)
else 0
f file compsize
(go $! total+compsize) False solidBlock rest
-- |Îäíîñòðî÷íûé ïðîñòîé ëèñòèíã ôàéëà
terse_list direntry compsize = do
let fi = cfFileInfo direntry
myPutStrLn$ (formatDateTime$ fiTime fi)
++ " " ++ right_justify 11 (if (fiIsDir fi) then ("-dir-") else (show3$ fiSize fi))
++ (if (cfIsEncrypted direntry) then "*" else " ")
++ filename direntry
-- |Îäíîñòðî÷íûé ïîäðîáíûé ëèñòèíã ôàéëà
verbose_list direntry compsize = do
let fi = cfFileInfo direntry
myPutStrLn$ (formatDateTime$ fiTime fi)
++ " " ++ (if (fiIsDir fi) then ".D....." else ".......")
++ " " ++ right_justify 15 (show$ fiSize fi)
++ " " ++ right_justify 15 (show$ compsize)
++ " " ++ left_fill '0' 8 (showHex (cfCRC direntry) "")
++ (if (cfIsEncrypted direntry) then "*" else " ")
++ filename direntry
{-
-- |Ìíîãîñòðî÷íûé òåõíè÷åñêèé ëèñòèíã ôàéëà
technical_list direntry = do
let fi = (cfFileInfo direntry)
timestr <- formatDateTime (fiTime fi)
myPutStrLn$ ""
myPutStrLn$ "Filename: " ++ (fpFullname$ fiStoredName fi)
myPutStrLn$ "Size: " ++ (show$ fiSize fi)
myPutStrLn$ "Date/time: " ++ timestr
myPutStrLn$ "CRC: " ++ showHex (cfCRC direntry) ""
myPutStrLn$ "Type: " ++ if (fiIsDir fi) then "directory" else "file"
-}
-- |Îïèñàíèå ñîëèä-áëîêà
data_block_list bl = do
myPutStrLn$ (if (blIsEncrypted bl) then "*" else " ")
++ " " ++ right_justify 15 (show3$ blPos bl)
++ " " ++ right_justify 15 (show3$ blOrigSize bl)
++ " " ++ right_justify 15 (show3$ blCompSize bl)
++ " " ++ right_justify 7 (show3$ blFiles bl)
++ " " ++ join_compressor (blCompressor bl)