vika
|
|
« : 13-02-2012 01:33 » |
|
Приветствую всех. Есть чудесная библиотека для упаковки яваскрипта под названием JavaScript::Packer А вот для распаковки автор что то не создал модуля, думала, может упаковщик и распаковывать сможет, а нет, в мане даже намека нету. На сайте автора упаковщика лежат какие исходники для perl, только они все датированы аж 2005 годом, не работают с новым перлом никак. Может кто то сталкивался с похожей проблемой, очень хотелось бы разобраться.
|
|
|
Записан
|
|
|
|
RXL
Технический
Администратор
Offline
Пол:
|
|
« Ответ #1 : 13-02-2012 03:32 » |
|
Ты смотрела, чем отличается "неупакованный" код от "упакованного"? На этот случай online-упаковщик: http://dean.edwards.name/packer/Ничего "чудесного" там нет. Просто удаляются все незначащие пробелы, переводы строк и комментарии. Соотв., обратное действие невозможно, но можно отформатировать код. Последняя фраза ключевая.
|
|
|
Записан
|
... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
|
|
|
vika
|
|
« Ответ #2 : 13-02-2012 17:47 » |
|
Ты смотрела, чем отличается "неупакованный" код от "упакованного"? На этот случай online-упаковщик: http://dean.edwards.name/packer/Ничего "чудесного" там нет. Просто удаляются все незначащие пробелы, переводы строк и комментарии. Соотв., обратное действие невозможно, но можно отформатировать код. Последняя фраза ключевая. Отличается пробелами (их удаляют) и перекодированием в base62. Что то нигде не нашла модуля для base62, есть только mime base64. А онлайн вариант не подойдет потому, что надо будет дергать за яйца какой нить онлайн сервис, что ни есть хорошо. Как вариант, был такой случай, в переменную получаю обфусцированный скрипт, шлю методом post в какую нибудь онлайн программу и также получаю готовый результат, но этот способ отпал сразу. Хочется решения на месте...
|
|
|
Записан
|
|
|
|
RXL
Технический
Администратор
Offline
Пол:
|
|
« Ответ #3 : 13-02-2012 18:47 » |
|
|
|
|
Записан
|
... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
|
|
|
vika
|
|
« Ответ #4 : 13-02-2012 18:56 » |
|
Спасибо, но все же хотелось на перле. На других языках я знаю, что проще, но вся программа задумывается как перловая. А смысл в том, что нужно получить кусок html кода, распарсить его (что сделано), из распарсенного выражения вытащить нужное значение регекспом, предварителньо это выражение перегоняется из криптованного вида в нормальный вид, форматирование значения не имеет... Насколько я поняла, javascript компрессор просто скрипт перегоняет в кодировку base62. Сколько самописных вариантов не видела, все или не работают или только кодируют в base62, без раскодирования. Жаль, что нет готового модуля, вроде mime base64, чтобы можно было его заюзать.
|
|
|
Записан
|
|
|
|
RXL
Технический
Администратор
Offline
Пол:
|
|
« Ответ #5 : 13-02-2012 19:02 » |
|
vika, там пять строчек. На perl это не будет длиннее. Или ты ищешь халяву? Пройдись по моим ссылкам. Декодировщики там приведены. Первая же ссылка: http://snipplr.com/view/22246/Кодировщик и декодировщик. Синтаксис PHP на этих примерах на 99% совместим с Perl. Кардинальное различие лишь в массивах и функциях. Добавлено через 20 минут и 27 секунд:Приведи фрагмент "сжатого" JavaScript.
|
|
« Последнее редактирование: 13-02-2012 19:31 от RXL »
|
Записан
|
... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
|
|
|
vika
|
|
« Ответ #6 : 13-02-2012 19:52 » |
|
eval(function(p,a,c,k,e,r){e=function(c){return(c<a?'':e(parseInt(c/a)))+((c=c%a)>35?String.fromCharCode(c+29):c.toString(36))};if(!''.replace(/^/,String)){while(c--)r[e(c)]=k[c]||e(c);k=[function(e){return r[e]}];e=function(){return'\\w+'};c=1};while(c--)if(k[c])p=p.replace(new RegExp('\\b'+e(c)+'\\b','g'),k[c]);return p}('<!--l--><m c="x-y"><n z="0"A="0"8="B%"><o><6 h="C"9="8:D;"><a 4="./E.2"><b>Главная</b></a>&;<a 4="p.2"><b>Трекер</b></a>&;<a 4="5.2"><b>Поиск</b></a>&;<a 4="F.2"><b>Правила</b></a>&;<a 4="G.2?H=I&J=K"L="M.N(7.4, \'\', O); q P;"><b>ПользовательскоеСоглашение</b></a>&;<a 4="Q.2"><b 9="R: #S;">T</b></a>&;<a 4="U.2"><b>Группы</b></a>&;<a 4="V.2"><b>Пользователи</b></a></6><6>&W;</6><6 9="8:X;"><r c="Y-5"d=""Z="10"11="$(7).12(\'d\', $(\'#5-d\').s());13 i=$(\'#5-j\').s(); q !(i==\'поиск...\' || !i);"><e f="t"k="14"3="1"><e f="t"k="15"3="1"><e c="5-j"f="j"k="16"17="u(7.3==\'поиск...\') 7.3=\'\';"18="u(7.3==\'\') 7.3=\'поиск...\';"3="поиск..."h="19"9="8: 1a;"><v c="5-d"><g 3="p.2#1b"w="w">потрекеру</g><g 3="5.2">пофоруму</g></v><e f="1c"h="1d 1e"3="&1f;"9="8: 1g;"></r></6></o></n></m><!--/l-->',62,79,'||php|value|href|search|td|this|width|style|||id|action|input|type|option|class|txt|text|name|main_nav|div|table|tr|tracker|return|form|val|hidden|if|select|selected|main|nav|cellpadding|cellspacing|100|nowrap|600px|index|rules|misc|do|info|show|user_agreement|onclick|window|open|InfoWinParams|false|faq|color|993300|FAQ|groupcp|memberlist|nbsp|300px|quick|method|post|onsubmit|attr|var|max|to|nm|onfocus|onblur|hint|120px|results|submit|med|bold|raquo|30px'.split('|'),0,{}))
|
|
|
Записан
|
|
|
|
Sla
|
|
« Ответ #7 : 13-02-2012 20:34 » |
|
Да уж Кто будет на стороне перла js eval выполнять?
|
|
|
Записан
|
Мы все учились понемногу... Чему-нибудь и как-нибудь.
|
|
|
vika
|
|
« Ответ #8 : 13-02-2012 20:47 » |
|
Да уж Кто будет на стороне перла js eval выполнять? А зачем его выполнять? Просто перевести в массив данных html и выудить нужную информацию. Js Compressor ведь по такому принципу работает, переводит в кодировку base62 и обрезает пробелы, там, где можно
|
|
|
Записан
|
|
|
|
RXL
Технический
Администратор
Offline
Пол:
|
|
« Ответ #9 : 13-02-2012 20:57 » |
|
Разложил для повышения читаемости. eval( function (p, a, c, k, e, r) { e = function(c) { return ( c < a ? '' : e(parseInt(c / a)) ) + ( (c = c % a) > 35 ? String.fromCharCode(c + 29) : c.toString(36) ) }; if (! ''.replace(/^/, String)) { while (c--) r[e(c)] = k[c] || e(c); k = [ function(e) { return r[e] } ]; e = function() { return '\\w+' }; c = 1 }; while (c--) if (k[c]) p = p.replace( new RegExp('\\b' + e(c) + '\\b', 'g'), k[c] ); return p } ( '<!--l--><m c="x-y"><n z="0"A="0"8="B%"><o><6 h="C"9="8:D;"><a 4="./E.2"><b>Главная</b></a>&;<a 4="p.2"><b>Трекер</b></a>&;<a 4="5.2"><b>Поиск</b></a>&;<a 4="F.2"><b>Правила</b></a>&;<a 4="G.2?H=I&J=K"L="M.N(7.4, \'\', O); q P;"><b>ПользовательскоеСоглашение</b></a>&;<a 4="Q.2"><b 9="R: #S;">T</b></a>&;<a 4="U.2"><b>Группы</b></a>&;<a 4="V.2"><b>Пользователи</b></a></6><6>&W;</6><6 9="8:X;"><r c="Y-5"d=""Z="10"11="$(7).12(\'d\', $(\'#5-d\').s());13 i=$(\'#5-j\').s(); q !(i==\'поиск...\' || !i);"><e f="t"k="14"3="1"><e f="t"k="15"3="1"><e c="5-j"f="j"k="16"17="u(7.3==\'поиск...\') 7.3=\'\';"18="u(7.3==\'\') 7.3=\'поиск...\';"3="поиск..."h="19"9="8: 1a;"><v c="5-d"><g 3="p.2#1b"w="w">потрекеру</g><g 3="5.2">пофоруму</g></v><e f="1c"h="1d 1e"3="&1f;"9="8: 1g;"></r></6></o></n></m><!--/l-->', 62, 79, '||php|value|href|search|td|this|width|style|||id|action|input|type|option|class|txt|text|name|main_nav|div|table|tr|tracker|return|form|val|hidden|if|select|selected|main|nav|cellpadding|cellspacing|100|nowrap|600px|index|rules|misc|do|info|show|user_agreement|onclick|window|open|InfoWinParams|false|faq|color|993300|FAQ|groupcp|memberlist|nbsp|300px|quick|method|post|onsubmit|attr|var|max|to|nm|onfocus|onblur|hint|120px|results|submit|med|bold|raquo|30px'.split('|'), 0, {} ) )
Да, черт ногу сломит, но невозможного тут нет. Добавлено через 1 минуту и 40 секунд:vika, ты ошибаешься. Base62 тут не пахнет. Посмотри на входные данные (строки 44 и 47).
|
|
« Последнее редактирование: 13-02-2012 20:58 от RXL »
|
Записан
|
... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
|
|
|
vika
|
|
« Ответ #10 : 13-02-2012 20:59 » |
|
Странно, что в перле нет ничего, чтобы с base62 работать. Имеющиеся коды написаны на коленке, причем непонятно кем, даже руководства не найти, не поймешь, что делать надо, откуда что взято... Добавлено через 2 минуты и 6 секунд:Так у самого разработчика этого пакера есть форма, там прямо указано, как преобразуется скрипт http://dean.edwards.name/packer/ (base62 и обрезание)
|
|
« Последнее редактирование: 13-02-2012 21:01 от vika »
|
Записан
|
|
|
|
RXL
Технический
Администратор
Offline
Пол:
|
|
« Ответ #11 : 13-02-2012 21:04 » |
|
К примеру, function (p, a, c, k, e, r) { ........... } ( '<!--l-->......<!--/l-->', 62, 79, '||php|value|......|raquo|30px'.split('|'), 0, {} ) означает p = '<!--l-->......<!--/l-->' a = 62 c = 79 k = '||php|value|......|raquo|30px'.split('|') e = 0 r = {} и оформлено так чисто для антуража, т.к. занимает больше места, чем читаемая запись. Добавлено через 3 минуты и 40 секунд:vika, задай себе вопрос: что такое "base62"? Только ответив на него будешь знать, нужно ли оно тебе и как его получить.
|
|
« Последнее редактирование: 13-02-2012 21:08 от RXL »
|
Записан
|
... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
|
|
|
vika
|
|
« Ответ #12 : 13-02-2012 21:13 » |
|
base 62 это способ кодировки информации, как например base64, md5 и т.п. Вот, думаю, заюзать что ли модуль JavaScript. Надо же как-то раскодировать данную околесицу. Тем более, что большинство онлайн кодеров/декодеров все это дело понимают и раскодировать могут без проблем. Какой то алгоритм все-таки есть, не с потолка же это взято.
|
|
|
Записан
|
|
|
|
RXL
Технический
Администратор
Offline
Пол:
|
|
« Ответ #13 : 13-02-2012 21:16 » |
|
vika, "способ кодировки информации" - это также и Морзянка. Может она тебе нужна? Я намекаю, что на вопрос ты не ответила.
|
|
|
Записан
|
... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
|
|
|
vika
|
|
« Ответ #14 : 13-02-2012 21:18 » |
|
vika, "способ кодировки информации" - это также и Морзянка. Может она тебе нужна? Я намекаю, что на вопрос ты не ответила. Ну, то что это не морзянка, я думаю и так видно. А как перефразировать, я не знаю, женский ум тут значительно уступает мужскому, потому и обратилась за помощью к толковым людям.
|
|
|
Записан
|
|
|
|
RXL
Технический
Администратор
Offline
Пол:
|
|
« Ответ #15 : 13-02-2012 21:23 » |
|
Нежелание напрягать голову - это плохо, но половую дифференциацию сюда прикладывать не надо. # JScript function "_unpack" - from DeanEdwards pack.js (NB: No ";" after final "}") ($_JSunpack) = <<'END_JSCRIPT_UNPACK'; /* unpacking function - this is the boot strap function */ /* data extracted from this packing routine is passed to */ /* this function when decoded in the target */ function($packed, $ascii, $count, $keywords, $encode, $decode) { while ($count--) if ($keywords[$count]) $packed = $packed.replace(new RegExp('\\b' + $encode($count) + '\\b', 'g'), $keywords[$count]); /* RS_Debug = $packed; */ /* {RS} !!!!!!!!! */ return $packed; } END_JSCRIPT_UNPACK
# JScript function "_decode" - from DeanEdwards pack.js ($_JSdecode) = <<'END_JSCRIPT_DECODE'; /* code-snippet inserted into the unpacker to speed up decoding */ function() { /* does the browser support String.replace where the */ /* replacement value is a function? */ if (!''.replace(/^/, String)) { /* decode all the values we need */ while ($count--) $decode[$encode($count)] = $keywords[$count] || $encode($count); /* global replacement function */ $keywords = [function($encoded){return $decode[$encoded]}]; /* generic match */ $encode = function(){return'\\w+'}; /* reset the loop counter - we are now doing a global replace */ $count = 1; } }; END_JSCRIPT_DECODE
# JScript versions of encoders ($_JSencode10) = <<'END_JSCRIPT_ENCODE10'; /* zero encoding */ /* characters: 0123456789 */ function($charCode) { return $charCode; }; END_JSCRIPT_ENCODE10
($_JSencode36) = <<'END_JSCRIPT_ENCODE36'; /* inherent base36 support */ /* characters: 0123456789abcdefghijklmnopqrstuvwxyz */ function($charCode) { return $charCode.toString(36); }; END_JSCRIPT_ENCODE36
($_JSencode62) = <<'END_JSCRIPT_ENCODE62'; /* hitch a ride on base36 and add the upper case alpha characters */ /* characters: 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ */ function($charCode) { return ($charCode < _encoding ? '' : arguments.callee(parseInt($charCode / _encoding))) + (($charCode = $charCode % _encoding) > 35 ? String.fromCharCode($charCode + 29) : $charCode.toString(36)); }; END_JSCRIPT_ENCODE62
($_JSencode95) = <<'END_JSCRIPT_ENCODE95'; /* use high-ascii values */ /* characters: ЎўЈ¤Ґ¦§Ё©Є«¬®Ї°±Ііґµ¶·ё№є»јЅѕїАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэю */ function($charCode) { return ($charCode < _encoding ? '' : arguments.callee($charCode / _encoding)) + String.fromCharCode($charCode % _encoding + 161); }; END_JSCRIPT_ENCODE95 Прилагается к perl-коду. Надо было только посмотреть. Модуль Pack.pm. Теперь дешефрация должна быть проще. Попробуй...
|
|
|
Записан
|
... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
|
|
|
Sla
|
|
« Ответ #16 : 13-02-2012 21:24 » |
|
ну на самом деле я думаю, что там будет что-то типа document.write а далее html код строчки указанные RXL
просто буква поставлена в соответствие "словарю"
|
|
|
Записан
|
Мы все учились понемногу... Чему-нибудь и как-нибудь.
|
|
|
vika
|
|
« Ответ #17 : 13-02-2012 21:34 » |
|
Спасибо, тольо этот вариант уже пробовался мною, в результате не работает потому, что требует недостающие библиотеки, устанавливала недостающие библиотеки, требует переустановить перл на версию, более страую, чем установленная (acriveperl 5.14.2)
|
|
|
Записан
|
|
|
|
RXL
Технический
Администратор
Offline
Пол:
|
|
« Ответ #18 : 13-02-2012 21:46 » |
|
vika, ты хоть пытаешься понять, что я тебе пишу? Там автор даже комментарии оставил.
|
|
|
Записан
|
... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
|
|
|
vika
|
|
« Ответ #19 : 13-02-2012 21:52 » |
|
Вот, что мне выдается Panic: Some symbols not resolvable from C:\packer2.perl\perl56.dll
|
|
|
Записан
|
|
|
|
RXL
Технический
Администратор
Offline
Пол:
|
|
« Ответ #20 : 13-02-2012 21:58 » |
|
Оставь perl и этот модуль в покое. Просто читай написанное. Ничего запускать не надо. Добавлено через 6 минут и 43 секунды:Итог: function unpack($packed, $count, $keywords) { while ($count--) if ($keywords[$count]) $packed = $packed.replace(new RegExp('\\b' + $encode($count) + '\\b', 'g'), $keywords[$count]); return $packed; }
function decode() { if (!''.replace(/^/, String)) { while ($count--) $decode[$encode($count)] = $keywords[$count] || $encode($count); $keywords = [function($encoded){return $decode[$encoded]}]; $encode = function(){return'\\w+'}; $count = 1; } };
function encode($charCode) { return ($charCode < _encoding ? '' : arguments.callee(parseInt($charCode / _encoding))) + (($charCode = $charCode % _encoding) > 35 ? String.fromCharCode($charCode + 29) : $charCode.toString(36)); };
_encoding = 62; unpack(packed, count, keywords); Это не Perl! Ничего не надо запускать!
|
|
« Последнее редактирование: 13-02-2012 22:05 от RXL »
|
Записан
|
... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
|
|
|
vika
|
|
« Ответ #21 : 13-02-2012 22:09 » |
|
А как тогда распаковать то? Что то совсем ничего не понятно. Я думала, что это просто модуль, который надо подключить в свой скрипт.
|
|
|
Записан
|
|
|
|
RXL
Технический
Администратор
Offline
Пол:
|
|
« Ответ #22 : 13-02-2012 22:29 » |
|
Скучно с тобой. Я то думал, ты хочешь разобраться и чему-то научиться. Выходит, что ты просто ищешь, кто за тебя сделает.
|
|
|
Записан
|
... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
|
|
|
vika
|
|
« Ответ #23 : 13-02-2012 22:33 » |
|
Конечно хочу, а вы говорите загадками. Если это способ распаковать локально обфусцированный скрипт, то он не представляет для меня интереса, как уже было сказано, я нуждаюсь в решении именно на perl. Вот, в чем проблема.
|
|
|
Записан
|
|
|
|
RXL
Технический
Администратор
Offline
Пол:
|
|
« Ответ #24 : 14-02-2012 05:39 » |
|
Скажешь тоже — загадками! Ведь ты же не читаешь, что я тебе пишу.
|
|
|
Записан
|
... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
|
|
|
vika
|
|
« Ответ #25 : 14-02-2012 17:49 » |
|
Я правильно поняла, что в perl это раскодировать нельзя? Ну, т.е., из этой абракадабры получить html код, неважно, с отступами или без? Как я уже говорила, мои рассуждения строились на том, что включив модуль pack.pm, можно в своем скрипте реализовать распознавание этого зашифрованного куска.
|
|
|
Записан
|
|
|
|
RXL
Технический
Администратор
Offline
Пол:
|
|
« Ответ #26 : 14-02-2012 18:34 » |
|
vika, ты практически все неправильно поняла. Модуль Pack.pm (регистр имеет значение!) не предназначен для распаковки, а только для упаковки. Но внутри него содержится хорошо читаемый и комментированный код для JavaScript, с помощью которого можно распаковать. Я приводил его выше. Тебе нужно разобрать алгоритм и реализовать его на Perl или другом, подходящем тебе языке.
|
|
|
Записан
|
... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
|
|
|
vika
|
|
« Ответ #27 : 14-02-2012 20:42 » |
|
Ну вот, теперь доходчиво и понятно. Спасибо. Будем пробовать...
|
|
|
Записан
|
|
|
|
vika
|
|
« Ответ #28 : 13-09-2012 01:13 » |
|
Собственно, уже тему создавала похожу, но теперь приперло. Приветствую всех. Есть пакер на яваскрипт, вот он http://dean.edwards.name/packer/Для перла сделан модуль, чтобы запаковывать, а вот распаковки что то автор порта на перл не сделал. Собственно, лог. подумав, пришла к выводу, что если есть алгоритм упаковки, то можно и распаковку сделать аналогично, но что то никак не соображу. Просьба подсказать, как действовать, ибо там столько всего намудрено, голова кругом идет. #Pack (July 2005) # Based on "Pack.js" by Dean Edwards <http://dean.edwards.name/> # Ported to Perl by Rob Seiler, ELR Software Pty Ltd <http://www.elr.com.au> # Copyright 2005. License <http://creativecommons.org/licenses/LGPL/2.1/>
package Pack; use strict; use Data::Dumper;
use ParseMaster;
# Package wide variable declarations use vars qw/$VERSION $PM_VERSION $_X_encodePrivate $_JSunpack $_JSdecode %baseLookup $_X_encode10 $_X_encode36 $_X_encode62 $_X_encode95 $_JSencode10 $_JSencode36 $_JSencode62 $_JSencode95 @_X_parsers $_X_script $_X_encoding $_X_fastDecode $_X_specialChars /; $VERSION = '024'; $PM_VERSION = $ParseMaster::VERSION;
# Package wide constants my $X_IGNORE = q{$1}; my $X_ENCODE = q/\x24encode\(\x24count\)/; # NB: requires g modifier my $PERL = 'perl'; # Flag to indicate whether we need to use one of our "internal" Perl encoding functions my $JSCRIPT = 'jscript'; # or embed a pre-build JScript encoding function ########################################
################## sub pack($$$$) { # require 4 arguments ################## #print Dumper(@_); ($_X_script, $_X_encoding, $_X_fastDecode, $_X_specialChars) = @_; # validate parameters (sort of!) $_X_script .= "\n"; $_X_encoding = ($_X_encoding > 95) ? 95 : $_X_encoding;
@_X_parsers = (); # Reset parsers
#################### sub _X_pack($) { # require 1 argument #################### # apply all parsing routines my $X_script = shift; for (my $i = 0; $i<scalar(@_X_parsers); $i++) { my $X_parse = $_X_parsers[$i]; $X_script = &$X_parse($X_script); } return $X_script; };
###################### sub _X_addParser { # ###################### # keep a list of parsing functions, they'll be executed all at once my $X_parser = shift; push (@_X_parsers,$X_parser); }
############################# sub _X_basicCompression { # ############################# # zero encoding - just removal of white space and comments my $X_script = shift; my $parser = ParseMaster->new(); # make safe $parser->escapeChar("\\"); # protect strings $parser->add(q/'[^'\n\r]*'/, $X_IGNORE); $parser->add(q/"[^"\n\r]*"/, $X_IGNORE); # remove comments $parser->add(q/\/\/[^\n\r]*[\n\r]/); $parser->add(q/\/\*[^*]*\*+([^\/][^*]*\*+)*\//); # protect regular expressions $parser->add(q/\s+(\/[^\/\n\r\*][^\/\n\r]*\/g?i?)/, q{$2}); # IGNORE $parser->add(q/[^\w\x24\/'"*)\?:]\/[^\/\n\r\*][^\/\n\r]*\/g?i?/, $X_IGNORE); # remove: ;;; doSomething(); $parser->add(q/;;[^\n\r]+[\n\r]/) if ($_X_specialChars); # remove redundant semi-colons $parser->add(q/;+\s*([};])/, q{$2}); # remove white-space $parser->add(q/(\b|\x24)\s+(\b|\x24)/, q{$2 $3}); $parser->add(q/([+\-])\s+([+\-])/, q{$2 $3}); $parser->add(q/\s+/, ''); # done return $parser->exec($X_script); }
############################### sub _X_encodeSpecialChars { # ############################### my $X_script = shift; my $parser = ParseMaster->new(); # replace: $name -> n, $$name -> $$na $parser->add(q/((\x24+)([a-zA-Z\x24_]+))(\d*)/, sub { my $X_offset = pop; my @X_match = @_; my $X_length = length($X_match[$X_offset+2]); my $lengthnext = length($X_match[$X_offset+3]); my $X_start = $X_length - ((($X_length - $lengthnext) > 0) ? ($X_length - $lengthnext) : 0); my $str = $X_match[$X_offset+1]; $str = substr($str,$X_start,$X_length) . $X_match[$X_offset+4]; return "$str"; }); # replace: _name -> _0, double-underscore (__name) is ignored my $X_regexp = q/\b_[A-Za-z\d]\w*/; # build the word list my %X_keywords = &_X_analyze($X_script, $X_regexp, $_X_encodePrivate); #print Dumper(%X_keywords); # quick ref my $X_encoded = \$X_keywords{X_encoded}; # eg _private1 => '_0',_private2 => '_1'; #print Dumper($X_encoded); $parser->add($X_regexp, sub {my $X_offset = pop; my @X_match = @_; return ${$X_encoded}->{$X_match[$X_offset]};});
return $parser->exec($X_script); };
########################### sub _X_encodeKeywords { # ########################### my $X_script = shift; # escape high-ascii values already in the script (i.e. in strings) if ($_X_encoding > 62) {$X_script = &_X_escape95($X_script)}; # create the parser my $parser = ParseMaster->new(); my $X_encode = &_X_getEncoder($_X_encoding,$PERL); # for high-ascii, don't encode single character low-ascii my $X_regexp = ($_X_encoding > 62) ? q/\w\w+/ : q/\w+/; # build the word list my %X_keywords = &_X_analyze($X_script, $X_regexp, $X_encode); #print Dumper(%X_keywords); my $X_encoded = \$X_keywords{X_encoded}; # eg alert => 2, function => 10 etc # encode $parser->add($X_regexp, sub {my $X_offset = pop; my @X_match = @_; return ${$X_encoded}->{$X_match[$X_offset]};}); # if encoded, wrap the script in a decoding function
return $X_script && _X_bootStrap(\$parser->exec($X_script), \%X_keywords); }
#################### sub _X_analyze { # #################### #print Dumper(@_); my ($X_script, $X_regexp, $X_encode) = @_; # analyse # retreive all words in the script my @X_all = $X_script =~ m/$X_regexp/g; # Save all captures in a list context my %XX_sorted = (); # list of words sorted by frequency my %XX_encoded = (); # dictionary of word->encoding my %XX_protected = (); # instances of "protected" words if (@X_all) { my @X_unsorted = (); # same list, not sorted my %X_protected = (); # "protected" words (dictionary of word->"word") my %X_values = (); # dictionary of charCode->encoding (eg. 256->ff) my %X_count = (); # word->count my $i = scalar(@X_all); my $j = 0; my $X_word = ''; # count the occurrences - used for sorting later do { $X_word = '$' . $X_all[--$i]; if (!exists($X_count{$X_word})) { $X_count{$X_word} = [0,$i]; # Store both the usage count and original array position (ie a secondary sort key) $X_unsorted[$j] = $X_word; # make a dictionary of all of the protected words in this script # these are words that might be mistaken for encoding $X_values{$j} = &$X_encode($j); my $v = '$'.$X_values{$j}; $X_protected{$v} = $j++; } # increment the word counter $X_count{$X_word}[0]++; } while ($i); #print Dumper (%X_values); #print Dumper (@X_unsorted); #print Dumper (%X_protected); # prepare to sort the word list, first we must protect # words that are also used as codes. we assign them a code # equivalent to the word itself. # e.g. if "do" falls within our encoding range # then we store keywords["do"] = "do"; # this avoids problems when decoding $i = scalar(@X_unsorted); do { $X_word = $X_unsorted[--$i]; if (exists($X_protected{$X_word})) { $XX_sorted{$X_protected{$X_word}} = substr($X_word,1); $XX_protected{$X_protected{$X_word}} = 1; # true $X_count{$X_word}[0] = 0; } } while ($i); #print Dumper (%XX_protected); #print Dumper (%XX_sorted); #print Dumper (%X_count); # sort the words by frequency # Sort with count a primary key and original array order as secondary key - which is apparently the default in javascript! @X_unsorted = sort ({($X_count{$b}[0] - $X_count{$a}[0]) or ($X_count{$b}[1] <=> $X_count{$a}[1])} @X_unsorted); #print Dumper (@X_unsorted) . "\n";
$j = 0; # because there are "protected" words in the list # we must add the sorted words around them do { if (!exists($XX_sorted{$i})) {$XX_sorted{$i} = substr($X_unsorted[$j++],1)} $XX_encoded{$XX_sorted{$i}} = $X_values{$i}; } while (++$i < scalar(@X_unsorted)); } #print Dumper(X_sorted => \%XX_sorted, X_encoded => \%XX_encoded, X_protected => \%XX_protected); return (X_sorted => \%XX_sorted, X_encoded => \%XX_encoded, X_protected => \%XX_protected); }
###################### sub _X_bootStrap { # ###################### # build the boot function used for loading and decoding my ($X_packed, $X_keywords) = @_; # Reference arguments! #print Dumper ($X_keywords) . "\n";
# $packed: the packed script - dereference and escape $X_packed = "'" . &_X_escape($$X_packed) ."'";
my %sorted = %{$$X_keywords{X_sorted}}; # Dereference to local variables my %protected = %{$$X_keywords{X_protected}}; # for simplicity
my @sorted = (); foreach my $key (keys %sorted) {$sorted[$key] = $sorted{$key}}; # Convert hash to a standard list
# ascii: base for encoding my $X_ascii = ((scalar(@sorted) > $_X_encoding) ? $_X_encoding : scalar(@sorted)) || 1;
# count: number of (unique {RS}) words contained in the script my $X_count = scalar(@sorted); # Use $X_count for assigning $X_ascii
# keywords: list of words contained in the script foreach my $i (keys %protected) {$sorted[$i] = ''}; # Blank out protected words #print Dumper(@sorted) . "\n";
# convert from a string to an array - prepare keywords as a JScript string->array {RS} $X_keywords = "'" . join('|',@sorted) . "'.split('|')";
# encode: encoding function (used for decoding the script) my $X_encode = $_X_encoding > 62 ? $_JSencode95 : &_X_getEncoder($X_ascii,$JSCRIPT); # This is a JScript function (as a string) $X_encode =~ s/_encoding/\x24ascii/g; $X_encode =~ s/arguments\.callee/\x24encode/g; my $X_inline = '$count' . ($X_ascii > 10 ? '.toString($ascii)' : '');
# decode: code snippet to speed up decoding my $X_decode = ''; if ($_X_fastDecode) { # create the decoder $X_decode = &_X_getFunctionBody($_JSdecode); # ie from the Javascript literal function if ($_X_encoding > 62) {$X_decode =~ s/\\\\w/[\\xa1-\\xff]/g} # perform the encoding inline for lower ascii values elsif ($X_ascii < 36) {$X_decode =~ s/$X_ENCODE/$X_inline/g} # special case: when $X_count==0 there ar no keywords. i want to keep # the basic shape of the unpacking funcion so i'll frig the code... if (!$X_count) {$X_decode =~ s/(\x24count)\s*=\s*1/$1=0/} }
# boot function my $X_unpack = $_JSunpack; if ($_X_fastDecode) { # insert the decoder $X_unpack =~ s/\{/\{$X_decode;/; } $X_unpack =~ s/"/'/g; if ($_X_encoding > 62) { # high-ascii # get rid of the word-boundaries for regexp matches $X_unpack =~ s/'\\\\b'\s*\+|\+\s*'\\\\b'//g; # Not checked! {RS} } if ($X_ascii > 36 || $_X_encoding > 62 || $_X_fastDecode) { # insert the encode function $X_unpack =~ s/\{/\{\$encode=$X_encode;/; } else { # perform the encoding inline $X_unpack =~ s/$X_ENCODE/$X_inline/; }
# arguments {RS} Do this before using &pack because &pack changes the pack parameters (eg $fastDecode) in Perl!! my $X_params = "$X_packed,$X_ascii,$X_count,$X_keywords"; # Interpolate to comma separated string if ($_X_fastDecode) { # insert placeholders for the decoder $X_params .= ',0,{}'; }
# pack the boot function too $X_unpack = &pack($X_unpack,0,0,1);
# the whole thing return "eval(" . $X_unpack . "(" . $X_params . "))\n"; };
####################### sub _X_getEncoder { # ####################### # mmm.. ..which one do i need ?? ({RS} Perl or JScript ??) my ($X_ascii,$language) = @_; my $perl_encoder = ($X_ascii > 10) ? ($X_ascii > 36) ? ($X_ascii > 62) ? $_X_encode95 : $_X_encode62 : $_X_encode36 : $_X_encode10; my $jscript_encoder = ($X_ascii > 10) ? ($X_ascii > 36) ? ($X_ascii > 62) ? $_JSencode95 : $_JSencode62 : $_JSencode36 : $_JSencode10; return ($language eq $JSCRIPT) ? $jscript_encoder : $perl_encoder; };
############################# # Perl versions of encoders # ############################# # base10 zero encoding - characters: 0123456789 $_X_encode10 = sub {return &_encodeBase(shift,10)}; # base36 - characters: 0123456789abcdefghijklmnopqrstuvwxyz $_X_encode36 = sub {return &_encodeBase(shift,36)}; # base62 - characters: 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ $_X_encode62 = sub {return &_encodeBase(shift,62)}; # high-ascii values - characters: ЎўЈ¤Ґ¦§Ё©Є«¬®Ї°±Ііґµ¶·ё№є»јЅѕїАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэю $_X_encode95 = sub {return &_encodeBase(shift,95)}; # Lookup character sets for baseN encoding $baseLookup{10} = [(0..9)[0..9]]; # base 10 $baseLookup{36} = [(0..9,'a'..'z')[0..35]]; # base 36 $baseLookup{62} = [(0..9,'a'..'z','A'..'Z')[0..61]]; # base 62 $baseLookup{95} = (); for (my $i=0; $i<95; $i++) {$baseLookup{95}[$i] = chr($i+161)}; # base95 (high ascii) #print Dumper(%baseLookup); ##################### sub _encodeBase { # ##################### # Generic base conversion function using defined lookup arrays (perl version only) my ($X_charCode, $base) = @_; my $X_encoded = ''; # Do we know this encoding? if (exists ($baseLookup{$base})) { if ($X_charCode == 0) {$X_encoded = $baseLookup{$base}[0]} while($X_charCode > 0) { $X_encoded = $baseLookup{$base}[$X_charCode % $base] . $X_encoded; $X_charCode = int($X_charCode / $base); } } else {$X_encoded = "$X_charCode"} # default is to return unchanged (ie as for base 10) if no baselookup is available return $X_encoded; };
############################# $_X_encodePrivate = sub { # ############################# # special _chars my $X_charCode = shift; return '_' . $X_charCode; };
############################ sub _X_escape($script) { # ############################ # protect characters used by the parser my $X_script = shift; $X_script =~ s/([\\'])/\\$1/g; return $X_script; };
##################### sub _X_escape95 { # ##################### # protect high-ascii characters already in the script my $X_script = shift; $X_script =~ s/([\xa1-\xff])/sprintf("\\x%1x",ord($1))/eg; return $X_script; };
############################ sub _X_getFunctionBody { # ############################ # extract the body of a function (ie between opening/closing {}) - consistent with Dean Edwards approach my $X_function = shift; $X_function =~ m/^.*\{(.*)\}*$/sg; # Multiline, global (greedy) my $start = index($X_function,'{'); my $end = rindex($X_function,'}'); $X_function = substr($X_function,($start+1),($end-1-$start)); return $X_function; };
###################### sub _X_globalize { # ###################### # set the global flag on a RegExp (you have to create a new one) !!! Unused in perl version # my $X_regexp = shift; };
# build the parsing routine &_X_addParser(\&_X_basicCompression); &_X_addParser(\&_X_encodeSpecialChars) if ($_X_specialChars); &_X_addParser(\&_X_encodeKeywords) if ($_X_encoding);
# go! return &_X_pack($_X_script); }
######################## # Javascript Literals # ########################
# JScript function "_unpack" - from DeanEdwards pack.js (NB: No ";" after final "}") ($_JSunpack) = <<'END_JSCRIPT_UNPACK'; /* unpacking function - this is the boot strap function */ /* data extracted from this packing routine is passed to */ /* this function when decoded in the target */ function($packed, $ascii, $count, $keywords, $encode, $decode) { while ($count--) if ($keywords[$count]) $packed = $packed.replace(new RegExp('\\b' + $encode($count) + '\\b', 'g'), $keywords[$count]); /* RS_Debug = $packed; */ /* {RS} !!!!!!!!! */ return $packed; } END_JSCRIPT_UNPACK
# JScript function "_decode" - from DeanEdwards pack.js ($_JSdecode) = <<'END_JSCRIPT_DECODE'; /* code-snippet inserted into the unpacker to speed up decoding */ function() { /* does the browser support String.replace where the */ /* replacement value is a function? */ if (!''.replace(/^/, String)) { /* decode all the values we need */ while ($count--) $decode[$encode($count)] = $keywords[$count] || $encode($count); /* global replacement function */ $keywords = [function($encoded){return $decode[$encoded]}]; /* generic match */ $encode = function(){return'\\w+'}; /* reset the loop counter - we are now doing a global replace */ $count = 1; } }; END_JSCRIPT_DECODE
# JScript versions of encoders ($_JSencode10) = <<'END_JSCRIPT_ENCODE10'; /* zero encoding */ /* characters: 0123456789 */ function($charCode) { return $charCode; }; END_JSCRIPT_ENCODE10
($_JSencode36) = <<'END_JSCRIPT_ENCODE36'; /* inherent base36 support */ /* characters: 0123456789abcdefghijklmnopqrstuvwxyz */ function($charCode) { return $charCode.toString(36); }; END_JSCRIPT_ENCODE36
($_JSencode62) = <<'END_JSCRIPT_ENCODE62'; /* hitch a ride on base36 and add the upper case alpha characters */ /* characters: 0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ */ function($charCode) { return ($charCode < _encoding ? '' : arguments.callee(parseInt($charCode / _encoding))) + (($charCode = $charCode % _encoding) > 35 ? String.fromCharCode($charCode + 29) : $charCode.toString(36)); }; END_JSCRIPT_ENCODE62
($_JSencode95) = <<'END_JSCRIPT_ENCODE95'; /* use high-ascii values */ /* characters: ЎўЈ¤Ґ¦§Ё©Є«¬®Ї°±Ііґµ¶·ё№є»јЅѕїАБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэю */ function($charCode) { return ($charCode < _encoding ? '' : arguments.callee($charCode / _encoding)) + String.fromCharCode($charCode % _encoding + 161); }; END_JSCRIPT_ENCODE95
########### # END # ########### 1; # Pack # ########### Неясно, правда, что ParseMaster.pm делает #ParseMaster (July 25 2005) # Based on "ParseMaster.js" by Dean Edwards <http://dean.edwards.name/> # Ported to Perl by Rob Seiler, ELR Software Pty Ltd <http://www.elr.com.au> # Copyright 2005. License <http://creativecommons.org/licenses/LGPL/2.1/>
package ParseMaster; use strict; use Data::Dumper;
# Package wide variable declarations use vars qw/$VERSION @_X_escaped @_X_patterns /;
$VERSION = '017';
# constants my $X_EXPRESSION = 0; my $X_REPLACEMENT = 1; my $X_LENGTH = 2;
# re's used to determine nesting levels my $X_GROUPS = qr/\(/o; # NB: Requires g modifier! my $X_SUB_REPLACE = qr/\$\d/o; my $X_INDEXED = qr/^\$\d+$/o; my $XX_ESCAPE = qr/\\./o; # NB: Requires g modifier! my $XX_DELETED = qr/\001[^\001]*\001/o; # NB: Requires g modifier! my $DIGIT = qr/[^\D]/o; # Yep - this is a digit - contains no non-digits
# Constructor sub new { my $class = shift; my $self = {}; @_X_escaped = (); # Re-initialize global for each instance @_X_patterns = (); # Re-initialize global for each instance # Instance variables - access by similarly named set/get functions $self->{_ignoreCase_} = 0; $self->{_escapeChar_} = ''; bless ($self, $class); return $self; }
sub ignoreCase { my ($self, $value) = @_; if (defined($value)) { $self->{_ignoreCase_} = $value; } return $self->{_ignoreCase_}; }
sub escapeChar{ my ($self, $value) = @_; if (defined($value)) { $self->{_escapeChar_} = $value; } return $self->{_escapeChar_}; }
####################### # Public Parsemaster functions
my $X_DELETE = sub(@$) { my $X_offset = pop; my @X_match = @_; return (chr(001) . $X_match[$X_offset] . chr(001)); }; # NB semicolon required for closure!
# create and add a new pattern to the patterns collection sub add { my ($self, $expression, $X_replacement) = @_; if (!$X_replacement) {$X_replacement = $X_DELETE};
# count the number of sub-expressions my $temp = &_X_internalEscape($expression); my $length = 1; # Always at least one because each pattern is itself a sub-expression $length += $temp =~ s/$X_GROUPS//g; # One way to count the left capturing parentheses in the regexp string
# does the pattern deal with sub-expressions? if ((ref($X_replacement) ne "CODE") && ($X_replacement =~ m/$X_SUB_REPLACE/)) { if ($X_replacement =~ m/$X_INDEXED/) { # a simple lookup? (eg "$2") # store the index (used for fast retrieval of matched strings) $X_replacement = substr($X_replacement,1) - 1; } else { # a complicated lookup (eg "Hello $2 $1") my $i = $length; while ($i) { # Had difficulty getting Perl to do Dean's splitting and joining of strings containing $'s my $str = '$a[$o+' . ($i-1) . ']'; # eg $a[$o+1] $X_replacement =~ s/\$$i/$str/; # eg $2 $3 -> $a[$o+1] $a[$o+2] $i--; } # build a function to do the lookup - returns interpolated string of array lookups $X_replacement = eval('sub {my $o=pop; my @a=@_; return "' . $X_replacement . '"};'); } } else {} # pass the modified arguments &_X_add($expression || q/^$/, $X_replacement, $length); }
# execute the global replacement sub exec { #print Dumper(@_X_patterns); my ($self, $X_string) = @_; my $escChar = $self->escapeChar(); my $ignoreCase = $self->ignoreCase(); my ($regexp,$captures) = &_getPatterns(); # Concatenated and parenthesized regexp eg '(regex1)|(regex2)|(regex3)' etc $X_string = &_X_escape($X_string, $escChar); if ($ignoreCase) {$X_string =~ s/$regexp/{&_X_replacement(&_matchVars($captures,\$X_string))}/gie} # Pass $X_String as a else {$X_string =~ s/$regexp/{&_X_replacement(&_matchVars($captures,\$X_string))}/ge} # reference for speed
$X_string = &_X_unescape($X_string, $escChar); $X_string =~ s/$XX_DELETED//g; return $X_string; }
sub _X_add { push (@_X_patterns, [@_]); # Save each argument set as is into an array of arrays }
# this is the global replace function (it's quite complicated) sub _X_replacement { my (@arguments) = @_; #print Dumper (@arguments); if ($arguments[0] le '') {return ''} # Dereference last index (source String) here - faster than in _matchVars (maybe not needed at all?) $arguments[$#arguments] = ${$arguments[$#arguments]}; my $i = 1; # loop through the patterns for (my $j=0; $j<scalar(@_X_patterns); $j++) { # Loop through global all @_X_patterns my @X_pattern = @{$_X_patterns[$j]}; # do we have a result? NB: "if ($arguments[$i])" as in Dean's Javascript is false for the value 0!!! if ((defined $arguments[$i]) && ($arguments[$i] gt '')) { my $X_replacement = $X_pattern[$X_REPLACEMENT]; # switch on type of $replacement if (ref($X_replacement) eq "CODE") { # function return &$X_replacement(@arguments,$i); } elsif ($X_replacement =~ m/$DIGIT/) { # number (contains no non-digits) return $arguments[$X_replacement + $i]; } else { # default return $X_replacement; # default } } # skip over references to sub-expressions else {$i += $X_pattern[$X_LENGTH]} } }
####################### # Private functions #######################
# encode escaped characters sub _X_escape { my ($X_string, $X_escapeChar) = @_; if ($X_escapeChar) { my $re = '\\'.$X_escapeChar.'(.)'; $X_string =~ s/$re/{push(@_X_escaped,$1); $X_escapeChar}/ge; } return $X_string; }
# decode escaped characters sub _X_unescape { my ($X_string, $X_escapeChar) = @_; if ($X_escapeChar) { # We'll only do this if there is an $X_escapeChar! my $re = '\\'.$X_escapeChar; $X_string =~ s/$re/{$X_escapeChar . (shift(@_X_escaped))}/ge; # Don't use Dean Edwards as below 'or' here - because zero will return ''! # $X_string =~ s/$re/{$X_escapeChar . (shift(@_X_escaped) || '')}/ge; } return $X_string; }
sub _X_internalEscape { my ($string) = shift; $string =~ s/$XX_ESCAPE//g; return $string; }
# Builds an array of match variables to (approximately) emulate that available in Javascript String.replace() sub _matchVars { my ($m,$sref) = @_; my @args = (1..$m); # establish the number potential memory variables my @mv = map {eval("\$$_")} @args; # matchvarv[1..m] = the memory variables $1 .. $m unshift (@mv, $&); # matchvar[0] = the substring that matched push (@mv, length($`)); # matchvar[m+1] = offset within the source string where the match occurred (= length of prematch string) push (@mv, $sref); # matchvar[m+2] = reference to full source string (dereference in caller if/when needed) #print Dumper (@mv); return @mv; }
sub _getPatterns { my @Patterns = (); my $lcp = 0; for (my $i=0; $i<scalar(@_X_patterns); $i++) { # Loop through global all @_patterns push (@Patterns, $_X_patterns[$i][$X_EXPRESSION]); # accumulate the expressions $lcp += $_X_patterns[$i][$X_LENGTH]; # sum the left capturing parenthesis counts } my $str = "(" . join(')|(',@Patterns). ")"; # enclose each pattern in () separated by "|" return ($str, $lcp); }
################## # END # ################## 1; # ParseMaster # ##################
|
|
« Последнее редактирование: 13-09-2012 03:48 от RXL »
|
Записан
|
|
|
|
RXL
Технический
Администратор
Offline
Пол:
|
|
« Ответ #29 : 13-09-2012 03:53 » |
|
Ничего нового в твоей теме нет. Темы объединил.
Вика, прошло 7 месяцев, а воз и ныне там? Перечитай посты данной темы начиная с ответа #15.
|
|
|
Записан
|
... мы преодолеваем эту трудность без синтеза распределенных прототипов. (с) Жуков М.С.
|
|
|
|